Changeset 5106 in project for synch/setup-header.scm


Ignore:
Timestamp:
07/15/07 22:57:55 (13 years ago)
Author:
Kon Lovett
Message:

New setup-header

File:
1 edited

Legend:

Unmodified
Added
Removed
  • synch/setup-header.scm

    r4418 r5106  
    88(define REPOSITORY-DIRECTORY (repository-path))
    99
     10(define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk"))
     11
    1012;; These must be kept in synch w/ testbase-results.scm!
    1113
    1214(define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase"))
    13 (define TESTBASE-TESTS-DIRECTORY (make-pathname TESTBASE-DIRECTORY "tests"))
    1415
    1516(define (->symbol obj)
     
    5051;;
    5152
     53#;
    5254(define (installed-program-exists? bn)
    5355  (or (file-exists? (make-program-pathname (program-path) bn))
     
    6769
    6870(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
    8782    (lambda (x)
    8883      (if (list? x)
    8984        ; 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)
    9386        ; else test is self contained
    94         (begin (copy-file-to-test-repository x) x)))
     87        (copy-testbase-file x) ) )
    9588    flnms) )
    96 
    97 (define (run-tests . tsts)
    98   ; Quote driver command for Windows.
    99   ; Test filenames CANNOT include whitespace (Windows issue).
    100   (for-each
    101     (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       (begin
    111         (when (setup-verbose-flag)
    112           (newline)
    113           (print "* Running test files" #\:) )
    114         (apply run-tests tsts) )
    115       (begin
    116         (newline)
    117         (print "* TestBase Driver is not installed; cannot perform testing.") ) ) ) )
    11889
    11990;; Options Parsing
     
    154125;;; Operation Macros
    155126
    156 ;; Note that these can accept quasi- stuff in OPT
     127;; Note that these can accept quasi-stuff in OPT
    157128
    158129(define-macro (compile-dynld DYNFIL . OPT)
Note: See TracChangeset for help on using the changeset viewer.