source: project/release/5/symbol-utils/trunk/tests/run.scm @ 38938

Last change on this file since 38938 was 38938, checked in by Kon Lovett, 11 months ago

add -strict-types, type is interface

File size: 2.3 KB
RevLine 
[38418]1;;;; run.scm -*- Scheme -*-
[35798]2
[38418]3(import scheme)
4
[38449]5;;; Create Egg Const
[38418]6
[35798]7(define EGG-NAME "symbol-utils")
8
9;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
10
[38938]11(import (only (chicken pathname)
12  make-pathname pathname-file pathname-replace-directory pathname-strip-extension))
[38418]13(import (only (chicken process) system))
14(import (only (chicken process-context) argv))
15(import (only (chicken format) format))
[38938]16(import (only (chicken file) file-exists? find-files))
17(import (only (chicken irregex) irregex irregex-match?))
[35798]18
[38938]19(define *args* (argv))
[35798]20
[38418]21(define (egg-name args #!optional (def EGG-NAME))
[35798]22  (cond
[38938]23    ((<= 4 (length *args*)) (cadddr *args*) )
24    (def                    def )
[35798]25    (else
[38938]26      (error 'run "cannot determine egg-name") ) ) )
[35798]27
[38938]28(define *current-directory* (cond-expand (unix "./") (else #f)))
[38418]29(define *egg* (egg-name *args*))
[35798]30
[38418]31;no -disable-interrupts or -no-lambda-info
32(define *csc-options* "-inline-global -local -inline \
33  -specialize -optimize-leaf-routines -clustering -lfa2 \
[38938]34  -no-trace -unsafe \
35  -strict-types")
[35798]36
[38938]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))
[38418]40
[38938]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)
[38418]52  ;csc output is in current directory
[38938]53  (system (string-append "csc" " " csc-options " " source))
54  (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
[38418]55
[35798]56;;;
57
[38938]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)
[38418]64    (newline)
[38938]65    (run-test-compiled source csc-options) ) )
[38418]66
[38938]67(define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
68  (for-each (cut run-test <> csc-options) tests) )
[38418]69
70;;; Do Test
71
72(run-tests)
Note: See TracBrowser for help on using the repository browser.