source: project/release/5/fx-utils/tags/4.0.0/tests/run.scm @ 38104

Last change on this file since 38104 was 38104, checked in by Kon Lovett, 6 weeks ago

rel 4.0.0

File size: 1.8 KB
Line 
1;;;; run.scm -*- Scheme -*-
2
3(import scheme)
4
5;;; Create Time Const
6
7(define EGG-NAME "fx-utils")
8
9;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
10
11(import
12  (only (chicken pathname) make-pathname)
13  (only (chicken process) system)
14  (only (chicken process-context) argv)
15  (only (chicken format) format))
16
17(define (test-filename test-name)
18  (string-append test-name "-test") )
19
20(define (egg-name args #!optional (def EGG-NAME))
21  (cond
22    ((<= 4 (length *args*))
23      (cadddr *args*) )
24    (def
25      def )
26    (else
27      (error 'test "cannot determine egg-name") ) ) )
28
29;;
30
31(define *args* (argv))
32(define *egg* (egg-name *args*))
33(define *tests* `(,*egg*))
34
35(define *current-directory* (cond-expand (unix "./") (else #f)))
36
37;no -disable-interrupts or -no-lambda-info
38(define *csc-options* "-inline-global -local -inline \
39  -specialize -optimize-leaf-routines -clustering -lfa2 \
40  -no-trace -unsafe")
41
42(define (run-test-evaluated test-name test-source)
43  (format #t "*** ~A - csi ***~%" test-name)
44  (system (string-append "csi -s " test-source)) )
45
46(define (run-test-compiled test-name test-source csc-options)
47  (format #t "*** ~A - csc ~A ***~%" test-name csc-options)
48  ;csc output is in current directory
49  (system (string-append "csc" " " csc-options " " test-source))
50  (system (make-pathname *current-directory* (test-filename test-name))) )
51
52;;;
53
54(define (run-test #!optional (test-name *egg*) (csc-options *csc-options*))
55  (let ((test-source (make-pathname #f (test-filename test-name) "scm")))
56    (run-test-evaluated test-name test-source)
57    (newline)
58    (run-test-compiled test-name test-source csc-options) ) )
59
60(define (run-tests #!optional (test-names *tests*) (csc-options *csc-options*))
61  (for-each (cut run-test <> csc-options) test-names) )
62
63;;; Do Test
64
65(run-tests)
Note: See TracBrowser for help on using the repository browser.