Changeset 5099 in project

Timestamp:

07/15/07 22:55:50 (14 years ago)

Author:

Kon Lovett

Message:

Changed to chicken-setup tests directory structure.

Location:

format-modular

Files:

• tags/1.7/setup-header.scm (modified) (4 diffs)
• trunk/format-modular-test.scm (deleted)
• trunk/format-modular.meta (modified) (1 diff)
• trunk/setup-header.scm (modified) (4 diffs)
• trunk/tests (added)
• trunk/tests.scm (deleted)
• trunk/tests/format-modular-test.scm (added)
• trunk/tests/run.scm (added)

format-modular/tags/1.7/setup-header.scm

@@ -8 +8 @@
 (define REPOSITORY-DIRECTORY (repository-path))
 
+(define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk"))
+
 ;; These must be kept in synch w/ testbase-results.scm!
 
 (define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase"))
-(define TESTBASE-TESTS-DIRECTORY (make-pathname TESTBASE-DIRECTORY "tests"))
 
 (define (->symbol obj)
@@ -50 +51 @@
 ;;
 
+#;
 (define (installed-program-exists? bn)
   (or (file-exists? (make-program-pathname (program-path) bn))
@@ -67 +69 @@
 
 (define (copy-file-to-test-repository fn)
-  (*file-copy (->string fn) TESTBASE-TESTS-DIRECTORY) )
-
-;; Install & Run Test(s)
-
-(define-constant TESTBASE-TEST-DRIVER "chicken-testbase-driver")
-(define-constant TESTBASE-TEST-DRIVER-OPTIONS "--indent 2")
-
-(define test-driver-arguments
-  (make-parameter
-    (string-append TESTBASE-TEST-DRIVER-OPTIONS
-                   (if (setup-verbose-flag) " -v" ""))
-    (lambda (x)
-      (if (string? x) x (test-driver-arguments)))))
-
-(define (copy-tests . flnms)
-  (unless (file-exists? TESTBASE-TESTS-DIRECTORY)
-    (create-directory TESTBASE-TESTS-DIRECTORY) )
-  (map
+  (*file-copy (->string fn) TESTBASE-DIRECTORY) )
+
+(define (copy-testbase-file bn)
+  (copy-file-to-test-repository (make-pathname "tests" (->string bn))) )
+
+;; Install TestBase related file(s)
+
+(define (install-test . flnms)
+  (newline)
+  (print "* Installing TestBase Test-Files in " TESTBASE-DIRECTORY #\:)
+  (for-each
     (lambda (x)
       (if (list? x)
         ; then has extra files (probably test data)
-        (begin
-          (for-each (cut copy-file-to-test-repository <>) x)
-          (car x))
+        (for-each copy-testbase-file x)
         ; else test is self contained
-        (begin (copy-file-to-test-repository x) x)))
+        (copy-testbase-file x) ) )
     flnms) )
-
-(define (run-tests . tsts)
-  ; Quote driver command for Windows.
-  ; Test filenames CANNOT include whitespace (Windows issue).
-  (for-each
-    (cute system* "\"~A\" ~A ~A"
-                  TESTBASE-TEST-DRIVER (test-driver-arguments) <>)
-    tsts) )
-
-(define (install-test . flnms)
-  (newline)
-  (print "* Installing TestBase Test-Files in " TESTBASE-TESTS-DIRECTORY #\:)
-  (let ([tsts (apply copy-tests flnms)])
-    (if (installed-program-exists? TESTBASE-TEST-DRIVER)
-      (begin
-        (when (setup-verbose-flag)
-          (newline)
-          (print "* Running test files" #\:) )
-        (apply run-tests tsts) )
-      (begin
-        (newline)
-        (print "* TestBase Driver is not installed; cannot perform testing.") ) ) ) )
 
 ;; Options Parsing
@@ -154 +125 @@
 ;;; Operation Macros
 
-;; Note that these can accept quasi- stuff in OPT
+;; Note that these can accept quasi-stuff in OPT
 
 (define-macro (compile-dynld DYNFIL . OPT)

format-modular/trunk/format-modular.meta

@@ -10 +10 @@
  (files
    "en"
+  "tests"
    "setup-header.scm"
    "format-modular.setup" "format-modular.html" "format-modular.scm"))

format-modular/trunk/setup-header.scm

@@ -8 +8 @@
 (define REPOSITORY-DIRECTORY (repository-path))
 
+(define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk"))
+
 ;; These must be kept in synch w/ testbase-results.scm!
 
 (define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase"))
-(define TESTBASE-TESTS-DIRECTORY (make-pathname TESTBASE-DIRECTORY "tests"))
 
 (define (->symbol obj)
@@ -50 +51 @@
 ;;
 
+#;
 (define (installed-program-exists? bn)
   (or (file-exists? (make-program-pathname (program-path) bn))
@@ -67 +69 @@
 
 (define (copy-file-to-test-repository fn)
-  (*file-copy (->string fn) TESTBASE-TESTS-DIRECTORY) )
-
-;; Install & Run Test(s)
-
-(define-constant TESTBASE-TEST-DRIVER "chicken-testbase-driver")
-(define-constant TESTBASE-TEST-DRIVER-OPTIONS "--indent 2")
-
-(define test-driver-arguments
-  (make-parameter
-    (string-append TESTBASE-TEST-DRIVER-OPTIONS
-                   (if (setup-verbose-flag) " -v" ""))
-    (lambda (x)
-      (if (string? x) x (test-driver-arguments)))))
-
-(define (copy-tests . flnms)
-  (unless (file-exists? TESTBASE-TESTS-DIRECTORY)
-    (create-directory TESTBASE-TESTS-DIRECTORY) )
-  (map
+  (*file-copy (->string fn) TESTBASE-DIRECTORY) )
+
+(define (copy-testbase-file bn)
+  (copy-file-to-test-repository (make-pathname "tests" (->string bn))) )
+
+;; Install TestBase related file(s)
+
+(define (install-test . flnms)
+  (newline)
+  (print "* Installing TestBase Test-Files in " TESTBASE-DIRECTORY #\:)
+  (for-each
     (lambda (x)
       (if (list? x)
         ; then has extra files (probably test data)
-        (begin
-          (for-each (cut copy-file-to-test-repository <>) x)
-          (car x))
+        (for-each copy-testbase-file x)
         ; else test is self contained
-        (begin (copy-file-to-test-repository x) x)))
+        (copy-testbase-file x) ) )
     flnms) )
-
-(define (run-tests . tsts)
-  ; Quote driver command for Windows.
-  ; Test filenames CANNOT include whitespace (Windows issue).
-  (for-each
-    (cute system* "\"~A\" ~A ~A"
-                  TESTBASE-TEST-DRIVER (test-driver-arguments) <>)
-    tsts) )
-
-(define (install-test . flnms)
-  (newline)
-  (print "* Installing TestBase Test-Files in " TESTBASE-TESTS-DIRECTORY #\:)
-  (let ([tsts (apply copy-tests flnms)])
-    (if (installed-program-exists? TESTBASE-TEST-DRIVER)
-      (begin
-        (when (setup-verbose-flag)
-          (newline)
-          (print "* Running test files" #\:) )
-        (apply run-tests tsts) )
-      (begin
-        (newline)
-        (print "* TestBase Driver is not installed; cannot perform testing.") ) ) ) )
 
 ;; Options Parsing
@@ -154 +125 @@
 ;;; Operation Macros
 
-;; Note that these can accept quasi- stuff in OPT
+;; Note that these can accept quasi-stuff in OPT
 
 (define-macro (compile-dynld DYNFIL . OPT)