Changeset 5099 in project
- Timestamp:
- 07/15/07 22:55:50 (14 years ago)
- Location:
- format-modular
- Files:
-
- 3 added
- 2 deleted
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
format-modular/tags/1.7/setup-header.scm
r4403 r5099 8 8 (define REPOSITORY-DIRECTORY (repository-path)) 9 9 10 (define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk")) 11 10 12 ;; These must be kept in synch w/ testbase-results.scm! 11 13 12 14 (define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase")) 13 (define TESTBASE-TESTS-DIRECTORY (make-pathname TESTBASE-DIRECTORY "tests"))14 15 15 16 (define (->symbol obj) … … 50 51 ;; 51 52 53 #; 52 54 (define (installed-program-exists? bn) 53 55 (or (file-exists? (make-program-pathname (program-path) bn)) … … 67 69 68 70 (define (copy-file-to-test-repository fn) 69 (*file-copy (->string fn) TESTBASE-TESTS-DIRECTORY) ) 70 71 ;; Install & Run Test(s) 72 73 (define-constant TESTBASE-TEST-DRIVER "chicken-testbase-driver") 74 (define-constant TESTBASE-TEST-DRIVER-OPTIONS "--indent 2") 75 76 (define test-driver-arguments 77 (make-parameter 78 (string-append TESTBASE-TEST-DRIVER-OPTIONS 79 (if (setup-verbose-flag) " -v" "")) 80 (lambda (x) 81 (if (string? x) x (test-driver-arguments))))) 82 83 (define (copy-tests . flnms) 84 (unless (file-exists? TESTBASE-TESTS-DIRECTORY) 85 (create-directory TESTBASE-TESTS-DIRECTORY) ) 86 (map 71 (*file-copy (->string fn) TESTBASE-DIRECTORY) ) 72 73 (define (copy-testbase-file bn) 74 (copy-file-to-test-repository (make-pathname "tests" (->string bn))) ) 75 76 ;; Install TestBase related file(s) 77 78 (define (install-test . flnms) 79 (newline) 80 (print "* Installing TestBase Test-Files in " TESTBASE-DIRECTORY #\:) 81 (for-each 87 82 (lambda (x) 88 83 (if (list? x) 89 84 ; then has extra files (probably test data) 90 (begin 91 (for-each (cut copy-file-to-test-repository <>) x) 92 (car x)) 85 (for-each copy-testbase-file x) 93 86 ; else test is self contained 94 ( begin (copy-file-to-test-repository x) x)))87 (copy-testbase-file x) ) ) 95 88 flnms) ) 96 97 (define (run-tests . tsts)98 ; Quote driver command for Windows.99 ; Test filenames CANNOT include whitespace (Windows issue).100 (for-each101 (cute system* "\"~A\" ~A ~A"102 TESTBASE-TEST-DRIVER (test-driver-arguments) <>)103 tsts) )104 105 (define (install-test . flnms)106 (newline)107 (print "* Installing TestBase Test-Files in " TESTBASE-TESTS-DIRECTORY #\:)108 (let ([tsts (apply copy-tests flnms)])109 (if (installed-program-exists? TESTBASE-TEST-DRIVER)110 (begin111 (when (setup-verbose-flag)112 (newline)113 (print "* Running test files" #\:) )114 (apply run-tests tsts) )115 (begin116 (newline)117 (print "* TestBase Driver is not installed; cannot perform testing.") ) ) ) )118 89 119 90 ;; Options Parsing … … 154 125 ;;; Operation Macros 155 126 156 ;; Note that these can accept quasi- 127 ;; Note that these can accept quasi-stuff in OPT 157 128 158 129 (define-macro (compile-dynld DYNFIL . OPT) -
format-modular/trunk/format-modular.meta
r4740 r5099 10 10 (files 11 11 "en" 12 "tests" 12 13 "setup-header.scm" 13 14 "format-modular.setup" "format-modular.html" "format-modular.scm")) -
format-modular/trunk/setup-header.scm
r4403 r5099 8 8 (define REPOSITORY-DIRECTORY (repository-path)) 9 9 10 (define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk")) 11 10 12 ;; These must be kept in synch w/ testbase-results.scm! 11 13 12 14 (define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase")) 13 (define TESTBASE-TESTS-DIRECTORY (make-pathname TESTBASE-DIRECTORY "tests"))14 15 15 16 (define (->symbol obj) … … 50 51 ;; 51 52 53 #; 52 54 (define (installed-program-exists? bn) 53 55 (or (file-exists? (make-program-pathname (program-path) bn)) … … 67 69 68 70 (define (copy-file-to-test-repository fn) 69 (*file-copy (->string fn) TESTBASE-TESTS-DIRECTORY) ) 70 71 ;; Install & Run Test(s) 72 73 (define-constant TESTBASE-TEST-DRIVER "chicken-testbase-driver") 74 (define-constant TESTBASE-TEST-DRIVER-OPTIONS "--indent 2") 75 76 (define test-driver-arguments 77 (make-parameter 78 (string-append TESTBASE-TEST-DRIVER-OPTIONS 79 (if (setup-verbose-flag) " -v" "")) 80 (lambda (x) 81 (if (string? x) x (test-driver-arguments))))) 82 83 (define (copy-tests . flnms) 84 (unless (file-exists? TESTBASE-TESTS-DIRECTORY) 85 (create-directory TESTBASE-TESTS-DIRECTORY) ) 86 (map 71 (*file-copy (->string fn) TESTBASE-DIRECTORY) ) 72 73 (define (copy-testbase-file bn) 74 (copy-file-to-test-repository (make-pathname "tests" (->string bn))) ) 75 76 ;; Install TestBase related file(s) 77 78 (define (install-test . flnms) 79 (newline) 80 (print "* Installing TestBase Test-Files in " TESTBASE-DIRECTORY #\:) 81 (for-each 87 82 (lambda (x) 88 83 (if (list? x) 89 84 ; then has extra files (probably test data) 90 (begin 91 (for-each (cut copy-file-to-test-repository <>) x) 92 (car x)) 85 (for-each copy-testbase-file x) 93 86 ; else test is self contained 94 ( begin (copy-file-to-test-repository x) x)))87 (copy-testbase-file x) ) ) 95 88 flnms) ) 96 97 (define (run-tests . tsts)98 ; Quote driver command for Windows.99 ; Test filenames CANNOT include whitespace (Windows issue).100 (for-each101 (cute system* "\"~A\" ~A ~A"102 TESTBASE-TEST-DRIVER (test-driver-arguments) <>)103 tsts) )104 105 (define (install-test . flnms)106 (newline)107 (print "* Installing TestBase Test-Files in " TESTBASE-TESTS-DIRECTORY #\:)108 (let ([tsts (apply copy-tests flnms)])109 (if (installed-program-exists? TESTBASE-TEST-DRIVER)110 (begin111 (when (setup-verbose-flag)112 (newline)113 (print "* Running test files" #\:) )114 (apply run-tests tsts) )115 (begin116 (newline)117 (print "* TestBase Driver is not installed; cannot perform testing.") ) ) ) )118 89 119 90 ;; Options Parsing … … 154 125 ;;; Operation Macros 155 126 156 ;; Note that these can accept quasi- 127 ;; Note that these can accept quasi-stuff in OPT 157 128 158 129 (define-macro (compile-dynld DYNFIL . OPT)
Note: See TracChangeset
for help on using the changeset viewer.