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

* 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
commit d10f7b572c
16 changed files with 38 additions and 31 deletions

View file

@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; 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 io ports) #:select (open-bytevector-output-port))
#:use-module (test-suite lib)

View file

@ -14,7 +14,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; 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 (system base compile))

View file

@ -1,5 +1,5 @@
;;;; 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
;;;; 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
;;;; 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 guile-test)
#:use-module (system base compile)

View file

@ -90,6 +90,9 @@
(define %test-dir
(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)
"Make file system TREE at DIR."
(define (touch file)
@ -152,7 +155,8 @@
(let ((enter? (lambda (n s r)
;; Enter only `test-suite/tests/'.
(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"))))
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
(down (lambda (n s r) (cons `(down ,n) r)))
@ -167,7 +171,7 @@
((('down (? (cut string=? <> %test-dir)))
between ...
('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)
(any (match-lambda (('down (= basename "tests")) #t) (_ #f))
between)
@ -195,7 +199,7 @@
(up (lambda (n s r) (cons `(up ,n) r)))
(skip (lambda (n s r) (cons `(skip ,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)
`((leaf ,name)))))

View file

@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; 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 (test-suite lib)
#:use-module ((system base compile) #:select (compile)))

View file

@ -1,6 +1,6 @@
;;;; 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
;;;; modify it under the terms of the GNU Lesser General Public
@ -205,4 +205,4 @@
(test-end (syntax-rules ()
((_) #t))))
(with-test-prefix "upstream tests"
(include-from-path "test-suite/tests/match.test.upstream")))
(include-from-path "tests/match.test.upstream")))

View file

@ -1,5 +1,5 @@
;;;; 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
;;;; 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
;;;; 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))
;; First, check that Guile modules are r6rs modules.
@ -71,7 +71,7 @@
(pass-if "import"
(eval '(begin
(import (test-suite tests rnrs-test-a))
(import (tests rnrs-test-a))
#t)
(current-module)))
@ -79,18 +79,18 @@
(not (module-local-variable (current-module) 'double)))
(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)"
(eq? iface (resolve-interface '(test-suite tests rnrs-test-a))))
(eq? iface (resolve-interface '(tests rnrs-test-a))))
(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)"
(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"
(and (memq iface (module-uses (current-module))) #t))

View file

@ -1,6 +1,6 @@
;;; 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
;; 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
(library (test-suite tests rnrs-test-a)
(library (tests rnrs-test-a)
(export double)
(import (guile))

View file

@ -1,6 +1,6 @@
;;;; 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
;;;; 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
;; 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")