source: project/release/5/message-digest-type/trunk/tests/run.scm @ 38496

Last change on this file since 38496 was 38496, checked in by Kon Lovett, 7 months ago

*-test runner, remove fixnum

File size: 2.3 KB
Line 
1;;;; run.scm -*- Scheme -*-
2
3(import scheme)
4
5;;; Create Egg Const
6
7(define EGG-NAME "message-digest-type")
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
36(define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
37(define (test-filename name) (string-append name "-test"))
38(define (test-files) (find-files "." #:test *test-files-rx* #:limit 1))
39
40(define (ensure-test-source-name name)
41  (if (irregex-match? *test-files-rx* name)
42    name
43    (make-pathname *current-directory* (test-filename name) "scm") ) )
44
45(define (run-test-evaluated source)
46  (format #t "*** ~A - csi ***~%" (pathname-file source))
47  (system (string-append "csi -s " source)) )
48
49(define (run-test-compiled source csc-options)
50  (format #t "*** ~A - csc ~A ***~%" (pathname-file source) csc-options)
51  ;csc output is in current directory
52  (system (string-append "csc" " " csc-options " " source))
53  (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
54
55;;;
56
57(define (run-test #!optional (name *egg*) (csc-options *csc-options*))
58  (let (
59    (source (ensure-test-source-name name)) )
60    (unless (file-exists? source)
61      (error 'run "no such file" source) )
62    (run-test-evaluated source)
63    (newline)
64    (run-test-compiled source csc-options) ) )
65
66(define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
67  (for-each (cut run-test <> csc-options) tests) )
68
69;;; Do Test
70
71(run-tests)
Note: See TracBrowser for help on using the repository browser.