guile/guile-core/test-suite ChangeLog guile-tes...

[Dirk Herrmann]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Dirk Herrmann <address@hidden>  01/01/26 08:49:28

Modified files:
        guile-core/test-suite: ChangeLog guile-test lib.scm 
        guile-core/test-suite/tests: r4rs.test 

Log message:
        * Fixed things that I had broken with the last patch :-(

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/test-suite/ChangeLog.diff?r1=1.52&r2=1.53
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/test-suite/guile-test.diff?r1=1.3&r2=1.4
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/test-suite/lib.scm.diff?r1=1.10&r2=1.11
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/test-suite/tests/r4rs.test.diff?r1=1.3&r2=1.4

Patches:
Index: guile/guile-core/test-suite/ChangeLog
diff -u guile/guile-core/test-suite/ChangeLog:1.52 
guile/guile-core/test-suite/ChangeLog:1.53
--- guile/guile-core/test-suite/ChangeLog:1.52  Fri Jan 26 05:44:57 2001
+++ guile/guile-core/test-suite/ChangeLog       Fri Jan 26 08:49:28 2001
@@ -1,5 +1,30 @@
 2001-01-26  Dirk Herrmann  <address@hidden>
 
+       This patch fixes things that I have broken with the last one :-(
+
+       * guile-test (test-suite):  New variable.
+
+       (data-file-name):  New function.  Has the same purpose as the
+       former function data-file from lib.scm.  Moved here in order to
+       have all file name handling at the same place.  In contrast to the
+       former 'data-file function, it is not checked whether a file
+       exists.  This allows to use this function also for file names of
+       files that are still to be created.
+
+       (test-file-name):  Use the global 'test-suite variable.
+
+       (main):  Initialize 'test-suite instead of a local variable.
+
+       * lib.scm:  Don't import paths any more.
+
+       (data-file):  Removed.  Resurrected with a sligtly different
+       functionality as 'data-file-name' in guile-test.
+
+       * r4rs.scm:  For all references to temporary file, make use of
+       data-file-name.
+
+2001-01-26  Dirk Herrmann  <address@hidden>
+
        The following patch was sent by Thien-Thi Nguyen and a little bit
        modified by me.
 
Index: guile/guile-core/test-suite/guile-test
diff -u guile/guile-core/test-suite/guile-test:1.3 
guile/guile-core/test-suite/guile-test:1.4
--- guile/guile-core/test-suite/guile-test:1.3  Fri Jan 26 05:44:57 2001
+++ guile/guile-core/test-suite/guile-test      Fri Jan 26 08:49:28 2001
@@ -84,6 +84,10 @@
             (ice-9 and-let*))
 
 
+;;; Variables that will receive their actual values later.
+(define test-suite default-test-suite)
+
+
 ;;; General utilities, that probably should be in a library somewhere.
 
 ;;; Enable debugging
@@ -120,13 +124,19 @@
 
 
 ;;; The test driver.
+
+
+;;; Localizing test files and temporary data files relative to the
+;;; test suite directory.
+
+(define (data-file-name filename)
+  (in-vicinity test-suite filename))
 
-(define (test-file-name test-dir test)
-  (in-vicinity test-dir test))
+(define (test-file-name test)
+  (in-vicinity test-suite test))
 
 ;;; Return a list of all the test files in the test tree.
 (define (enumerate-tests test-dir)
-  
   (let ((root-len (+ 1 (string-length test-dir)))
        (tests '()))
     (for-each-file (lambda (file)
@@ -159,12 +169,13 @@
 
     (if (opt 'debug #f)
        (enable-debug-mode))
+
+    (set! test-suite
+         (or (opt 'test-suite #f)
+             (getenv "TEST_SUITE_DIR")
+             default-test-suite))
 
-    (let* ((test-suite
-           (or (opt 'test-suite #f)
-               (getenv "TEST_SUITE_DIR")
-               default-test-suite))
-          (tests 
+    (let* ((tests
            (let ((foo (opt '() '())))
              (if (null? foo) 
                  (enumerate-tests test-suite)
@@ -189,7 +200,7 @@
          ;; Run the tests.
          (for-each (lambda (test)
                      (with-test-prefix test
-                       (load (test-file-name test-suite test))))
+                       (load (test-file-name test))))
                    tests)
 
          ;; Display the final counts, both to the user and in the log
Index: guile/guile-core/test-suite/lib.scm
diff -u guile/guile-core/test-suite/lib.scm:1.10 
guile/guile-core/test-suite/lib.scm:1.11
--- guile/guile-core/test-suite/lib.scm:1.10    Mon Aug 21 01:57:11 2000
+++ guile/guile-core/test-suite/lib.scm Fri Jan 26 08:49:28 2001
@@ -16,8 +16,7 @@
 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 ;;;; Boston, MA 02111-1307 USA
 
-(define-module (test-suite lib)
-  #:use-module (test-suite paths))
+(define-module (test-suite lib))
 
 (export
 
@@ -423,17 +422,6 @@
       (apply full-reporter result name args)))
 
 (set! default-reporter full-reporter)
-
-
-;;;; Helping test cases find their files
-
-;;; Returns FILENAME, relative to the directory the test suite data
-;;; files were installed in, and makes sure the file exists.
-(define (data-file filename)
-  (let ((f (in-vicinity datadir filename)))
-    (or (file-exists? f)
-       (error "Test suite data file does not exist: " f))
-    f))
 
 
 ;;;; Detecting whether errors occur
Index: guile/guile-core/test-suite/tests/r4rs.test
diff -u guile/guile-core/test-suite/tests/r4rs.test:1.3 
guile/guile-core/test-suite/tests/r4rs.test:1.4
--- guile/guile-core/test-suite/tests/r4rs.test:1.3     Sun Aug  1 01:06:15 1999
+++ guile/guile-core/test-suite/tests/r4rs.test Fri Jan 26 08:49:28 2001
@@ -547,14 +547,14 @@
   (set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13)
   (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj)))
   (test #t call-with-output-file
-      "tmp3"
+      (data-file-name "tmp3")
       (lambda (test-file)
        (write-char #\; test-file)
        (display write-test-obj test-file)
        (newline test-file)
        (write load-test-obj test-file)
        (output-port? test-file)))
-  (check-test-file "tmp3")
+  (check-test-file (data-file-name "tmp3"))
   (set! write-test-obj wto)
   (set! display-test-obj dto)
   (set! load-test-obj lto)
@@ -935,8 +935,8 @@
 (SECTION 6 10 1)
 (test #t input-port? (current-input-port))
 (test #t output-port? (current-output-port))
-(test #t call-with-input-file (data-file "tests/r4rs.test") input-port?)
-(define this-file (open-input-file (data-file "tests/r4rs.test")))
+(test #t call-with-input-file (data-file-name "r4rs.test") input-port?)
+(define this-file (open-input-file (data-file-name "r4rs.test")))
 (test #t input-port? this-file)
 (SECTION 6 10 2)
 (test #\; peek-char this-file)
@@ -968,23 +968,23 @@
 (define load-test-obj
   (list 'define 'foo (list 'quote write-test-obj)))
 (test #t call-with-output-file
-      "tmp1"
+      (data-file-name "tmp1")
       (lambda (test-file)
        (write-char #\; test-file)
        (display write-test-obj test-file)
        (newline test-file)
        (write load-test-obj test-file)
        (output-port? test-file)))
-(check-test-file "tmp1")
+(check-test-file (data-file-name "tmp1"))
 
-(define test-file (open-output-file "tmp2"))
+(define test-file (open-output-file (data-file-name "tmp2")))
 (write-char #\; test-file)
 (display write-test-obj test-file)
 (newline test-file)
 (write load-test-obj test-file)
 (test #t output-port? test-file)
 (close-output-port test-file)
-(check-test-file "tmp2")
+(check-test-file (data-file-name "tmp2"))
 (define (test-sc4)
   (SECTION 6 7)
   (test '(#\P #\space #\l) string->list "P l")
@@ -997,7 +997,7 @@
   (test '#(dididit dah) list->vector '(dididit dah))
   (test '#() list->vector '())
   (SECTION 6 10 4)
-  (load (data-file "tmp1"))
+  (load (data-file-name "tmp1"))
   (test write-test-obj 'load foo)
   (report-errs))