source: project/release/5/srfi-29/trunk/tests/run.scm @ 38454

Last change on this file since 38454 was 38454, checked in by Kon Lovett, 18 months ago

style, update comment

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