source: project/release/5/unitex-named-chars/trunk/tests/run.scm @ 39028

Last change on this file since 39028 was 39028, checked in by Kon Lovett, 7 weeks ago

add Unicode & LaTeX Named Chars egg

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