source: project/release/5/amb/trunk/tests/run.scm @ 38735

Last change on this file since 38735 was 38735, checked in by Kon Lovett, 4 months ago

fix version, update test runner

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