mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

move (test-suite lib) to lower dir; cleans up uninstalled paths.

Browse source 
* check-guile.in:
* test-suite/Makefile.am:
* test-suite/test-suite/lib.scm:

* benchmark-guile.in:
* benchmark-suite/Makefile.am:
* benchmark-suite/benchmark-suite/lib.scm: Lower the lib modules in the
  source tree.  This lets us remove top_srcdir and top_builddir from the
  uninstalled paths.

* test-suite/tests/asm-to-bytecode.test:
* test-suite/tests/brainfuck.test:
* test-suite/tests/compiler.test:
* test-suite/tests/ftw.test:
* test-suite/tests/gc.test:
* test-suite/tests/match.test:
* test-suite/tests/rnrs-libraries.test:
* test-suite/tests/rnrs-test-a.scm:
* test-suite/tests/sxml.match.test: Adapt to not expect that module
  names be prefixed with "test-suite".
This commit is contained in:
Andy Wingo 2012-04-21 17:06:48 -04:00
parent 7a4188c449
commit d10f7b572c
16 changed files with 38 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

1
benchmark-guile.in
View file

@ -41,6 +41,7 @@ if [ ! -f guile-procedures.txt ] ; then
fi fi
exec $guile \ exec $guile \
-L "$BENCHMARK_SUITE_DIR" \
-e main -s "$BENCHMARK_SUITE_DIR/guile-benchmark" \ -e main -s "$BENCHMARK_SUITE_DIR/guile-benchmark" \
--benchmark-suite "$BENCHMARK_SUITE_DIR/benchmarks" \ --benchmark-suite "$BENCHMARK_SUITE_DIR/benchmarks" \
--log-file benchmark-guile.log "$@" --log-file benchmark-guile.log "$@"

3
benchmark-suite/Makefile.am
View file

@ -18,5 +18,6 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/write.bm \ benchmarks/write.bm \
benchmarks/strings.bm benchmarks/strings.bm
EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \ EXTRA_DIST = guile-benchmark benchmark-suite/lib.scm \
$(SCM_BENCHMARKS) \
ChangeLog-2008 ChangeLog-2008

0
benchmark-suite/lib.scm → benchmark-suite/benchmark-suite/lib.scm
View file

1
check-guile.in
View file

@ -43,6 +43,7 @@ fi
exec $guile \ exec $guile \
--debug \ --debug \
-L "$TEST_SUITE_DIR" \
--no-auto-compile -e main -s "$TEST_SUITE_DIR/guile-test" \ --no-auto-compile -e main -s "$TEST_SUITE_DIR/guile-test" \
--test-suite "$TEST_SUITE_DIR/tests" \ --test-suite "$TEST_SUITE_DIR/tests" \
--log-file check-guile.log "$@" --log-file check-guile.log "$@"

12
meta/uninstalled-env.in
View file

@ -1,6 +1,6 @@
#!/bin/sh #!/bin/sh
# Copyright (C) 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation # Copyright (C) 2003, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation
# #
# This file is part of GUILE. # This file is part of GUILE.
# #
@ -57,12 +57,12 @@ if test "@cross_compiling@" = "no"
then then
if [ x"$GUILE_LOAD_PATH" = x ] if [ x"$GUILE_LOAD_PATH" = x ]
then then
GUILE_LOAD_PATH="${top_srcdir}/module:${top_srcdir}/guile-readline:${top_srcdir}" GUILE_LOAD_PATH="${top_srcdir}/module:${top_srcdir}/guile-readline"
if test "${top_srcdir}" != "${top_builddir}"; then if test "${top_srcdir}" != "${top_builddir}"; then
GUILE_LOAD_PATH="$GUILE_LOAD_PATH:${top_builddir}/module:${top_builddir}/guile-readline:${top_builddir}" GUILE_LOAD_PATH="$GUILE_LOAD_PATH:${top_builddir}/module:${top_builddir}/guile-readline"
fi fi
else else
for d in "/module" "/guile-readline" "" for d in "/module" "/guile-readline"
do do
# This hair prevents double inclusion. # This hair prevents double inclusion.
# The ":" prevents prefix aliasing. # The ":" prevents prefix aliasing.
@ -82,9 +82,9 @@ then
if test "x$GUILE_LOAD_COMPILED_PATH" = "x" if test "x$GUILE_LOAD_COMPILED_PATH" = "x"
then then
GUILE_LOAD_COMPILED_PATH="${top_builddir}/module:${top_builddir}/guile-readline:${top_builddir}" GUILE_LOAD_COMPILED_PATH="${top_builddir}/module:${top_builddir}/guile-readline"
else else
for d in "/module" "/guile-readline" "" for d in "/module" "/guile-readline"
do do
# This hair prevents double inclusion. # This hair prevents double inclusion.
# The ":" prevents prefix aliasing. # The ":" prevents prefix aliasing.

4
test-suite/Makefile.am
View file

@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in. ## Process this file with automake to produce Makefile.in.
## ##
## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, ## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
## 2010, 2011 Software Foundation, Inc. ## 2010, 2011, 2012 Software Foundation, Inc.
## ##
## This file is part of GUILE. ## This file is part of GUILE.
## ##
@ -165,7 +165,7 @@ SCM_TESTS = tests/00-initial-env.test \
EXTRA_DIST = \ EXTRA_DIST = \
guile-test \ guile-test \
lib.scm \ test-suite/lib.scm \
$(SCM_TESTS) \ $(SCM_TESTS) \
tests/rnrs-test-a.scm tests/rnrs-test-a.scm
ChangeLog-2008 ChangeLog-2008

0
test-suite/lib.scm → test-suite/test-suite/lib.scm
View file

2
test-suite/tests/asm-to-bytecode.test
View file

@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software ;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite tests asm-to-bytecode) (define-module (tests asm-to-bytecode)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module ((rnrs io ports) #:select (open-bytevector-output-port)) #:use-module ((rnrs io ports) #:select (open-bytevector-output-port))
#:use-module (test-suite lib) #:use-module (test-suite lib)

2
test-suite/tests/brainfuck.test
View file

@ -14,7 +14,7 @@
;;;; License along with this library; if not, write to the Free Software ;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite tests brainfuck) (define-module (tests brainfuck)
#:use-module (test-suite lib) #:use-module (test-suite lib)
#:use-module (system base compile)) #:use-module (system base compile))

4
test-suite/tests/compiler.test
View file

@ -1,5 +1,5 @@
;;;; compiler.test --- tests for the compiler -*- scheme -*- ;;;; compiler.test --- tests for the compiler -*- scheme -*-
;;;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -15,7 +15,7 @@
;;;; License along with this library; if not, write to the Free Software ;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite tests compiler) (define-module (tests compiler)
#:use-module (test-suite lib) #:use-module (test-suite lib)
#:use-module (test-suite guile-test) #:use-module (test-suite guile-test)
#:use-module (system base compile) #:use-module (system base compile)

10
test-suite/tests/ftw.test
View file

@ -90,6 +90,9 @@
(define %test-dir (define %test-dir
(string-append %top-srcdir "/test-suite")) (string-append %top-srcdir "/test-suite"))
(define %test-suite-lib-dir
(string-append %top-srcdir "/test-suite/test-suite"))
(define (make-file-tree dir tree) (define (make-file-tree dir tree)
"Make file system TREE at DIR." "Make file system TREE at DIR."
(define (touch file) (define (touch file)
@ -152,7 +155,8 @@
(let ((enter? (lambda (n s r) (let ((enter? (lambda (n s r)
;; Enter only `test-suite/tests/'. ;; Enter only `test-suite/tests/'.
(if (member `(down ,%test-dir) r) (if (member `(down ,%test-dir) r)
(string=? (basename n) "tests") (or (string=? (basename n) "tests")
(string=? (basename n) "test-suite"))
(string=? (basename n) "test-suite")))) (string=? (basename n) "test-suite"))))
(leaf (lambda (n s r) (cons `(leaf ,n) r))) (leaf (lambda (n s r) (cons `(leaf ,n) r)))
(down (lambda (n s r) (cons `(down ,n) r))) (down (lambda (n s r) (cons `(down ,n) r)))
@ -167,7 +171,7 @@
((('down (? (cut string=? <> %test-dir))) ((('down (? (cut string=? <> %test-dir)))
between ... between ...
('up (? (cut string=? <> %test-dir)))) ('up (? (cut string=? <> %test-dir))))
(and (any (match-lambda (('leaf (= basename "lib.scm")) #t) (_ #f)) (and (any (match-lambda (('down (= basename "test-suite")) #t) (_ #f))
between) between)
(any (match-lambda (('down (= basename "tests")) #t) (_ #f)) (any (match-lambda (('down (= basename "tests")) #t) (_ #f))
between) between)
@ -195,7 +199,7 @@
(up (lambda (n s r) (cons `(up ,n) r))) (up (lambda (n s r) (cons `(up ,n) r)))
(skip (lambda (n s r) (cons `(skip ,n) r))) (skip (lambda (n s r) (cons `(skip ,n) r)))
(error (lambda (n s e r) (cons `(error ,n) r))) (error (lambda (n s e r) (cons `(error ,n) r)))
(name (string-append %test-dir "/lib.scm"))) (name (string-append %test-suite-lib-dir "/lib.scm")))
(equal? (file-system-fold enter? leaf down up skip error '() name) (equal? (file-system-fold enter? leaf down up skip error '() name)
`((leaf ,name))))) `((leaf ,name)))))

2
test-suite/tests/gc.test
View file

@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software ;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite tests gc) (define-module (tests gc)
#:use-module (ice-9 documentation) #:use-module (ice-9 documentation)
#:use-module (test-suite lib) #:use-module (test-suite lib)
#:use-module ((system base compile) #:select (compile))) #:use-module ((system base compile) #:select (compile)))

4
test-suite/tests/match.test
View file

@ -1,6 +1,6 @@
;;;; match.test --- (ice-9 match) -*- mode: scheme; coding: utf-8; -*- ;;;; match.test --- (ice-9 match) -*- mode: scheme; coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -205,4 +205,4 @@
(test-end (syntax-rules () (test-end (syntax-rules ()
((_) #t)))) ((_) #t))))
(with-test-prefix "upstream tests" (with-test-prefix "upstream tests"
(include-from-path "test-suite/tests/match.test.upstream"))) (include-from-path "tests/match.test.upstream")))

16
test-suite/tests/rnrs-libraries.test
View file

@ -1,5 +1,5 @@
;;;; rnrs-libraries.test --- test library and import forms -*- scheme -*- ;;;; rnrs-libraries.test --- test library and import forms -*- scheme -*-
;;;; Copyright (C) 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -15,7 +15,7 @@
;;;; License along with this library; if not, write to the Free Software ;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite tests rnrs-libraries) (define-module (tests rnrs-libraries)
#:use-module (test-suite lib)) #:use-module (test-suite lib))
;; First, check that Guile modules are r6rs modules. ;; First, check that Guile modules are r6rs modules.
@ -71,7 +71,7 @@
(pass-if "import" (pass-if "import"
(eval '(begin (eval '(begin
(import (test-suite tests rnrs-test-a)) (import (tests rnrs-test-a))
#t) #t)
(current-module))) (current-module)))
@ -79,18 +79,18 @@
(not (module-local-variable (current-module) 'double))) (not (module-local-variable (current-module) 'double)))
(pass-if "resolve-interface" (pass-if "resolve-interface"
(module? (resolve-interface '(test-suite tests rnrs-test-a)))) (module? (resolve-interface '(tests rnrs-test-a))))
(set! iface (resolve-interface '(test-suite tests rnrs-test-a))) (set! iface (resolve-interface '(tests rnrs-test-a)))
(pass-if "resolve-interface (2)" (pass-if "resolve-interface (2)"
(eq? iface (resolve-interface '(test-suite tests rnrs-test-a)))) (eq? iface (resolve-interface '(tests rnrs-test-a))))
(pass-if "resolve-r6rs-interface" (pass-if "resolve-r6rs-interface"
(eq? iface (resolve-r6rs-interface '(test-suite tests rnrs-test-a)))) (eq? iface (resolve-r6rs-interface '(tests rnrs-test-a))))
(pass-if "resolve-r6rs-interface (2)" (pass-if "resolve-r6rs-interface (2)"
(eq? iface (resolve-r6rs-interface '(library (test-suite tests rnrs-test-a))))) (eq? iface (resolve-r6rs-interface '(library (tests rnrs-test-a)))))
(pass-if "module uses" (pass-if "module uses"
(and (memq iface (module-uses (current-module))) #t)) (and (memq iface (module-uses (current-module))) #t))

4
test-suite/tests/rnrs-test-a.scm
View file

@ -1,6 +1,6 @@
;;; test of defining rnrs libraries ;;; test of defining rnrs libraries
;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -17,7 +17,7 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(library (test-suite tests rnrs-test-a) (library (tests rnrs-test-a)
(export double) (export double)
(import (guile)) (import (guile))

4
test-suite/tests/sxml.match.test
View file

@ -1,6 +1,6 @@
;;;; sxml.simple.test --- (sxml simple) -*- mode: scheme; coding: utf-8; -*- ;;;; sxml.simple.test --- (sxml simple) -*- mode: scheme; coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -42,4 +42,4 @@
;; FIXME: The `xyzpq' variable in there is originally named `x' but using that ;; FIXME: The `xyzpq' variable in there is originally named `x' but using that
;; name triggers a psyntax "identifier out of context" error. ;; name triggers a psyntax "identifier out of context" error.
(include-from-path "test-suite/tests/sxml-match-tests.ss") (include-from-path "tests/sxml-match-tests.ss")