source: project/release/4/stack/trunk/tests/run.scm @ 34413

Last change on this file since 34413 was 34413, checked in by Kon Lovett, 3 years ago

bump ver, re-flow

File size: 1.7 KB
Line 
1;;;; run.scm
2
3(define-constant TEST-SOURCE-FILE "test-impl.scm")
4
5(cond-expand
6  ;
7  (unix
8    ;
9    (use utils)
10    ;
11    (define (system-normal? . args)
12      ;preform system command & exit upon error
13      (receive (normal? code) (apply system/status args)
14        (cond
15          ((not normal?)
16            (exit (fxneg code)) )
17          ((not (fx= 0 code))
18            (exit code) ) ) )
19      ;ok
20      #t )
21    ;
22    (define (system/status . args)
23      (process-status (apply system args)) )
24    ;
25    ;from manual: library # system
26    ;; Returns two values: #t if the process exited normally or #f otherwise;
27    ;; and either the exit status, or the signal number if terminated via signal.
28    (define (process-status rc)
29      (define (wait-signaled? x) (not (fx= 0 (bitwise-and x 127))))
30      (define (wait-signal x) (bitwise-and x 127))
31      (define (wait-exit-status x) (arithmetic-shift x -8))
32      (if (wait-signaled? rc)
33        (values #f (wait-signal rc))
34        (values #t (wait-exit-status rc)) ) )
35    ;
36    (define (stgmsg msg)
37      (print) (print "*** " msg " ***") (print) )
38    ;
39    (define (csi-n-csc fil #!optional (csi "csi") (csc-opt (compile-file-options)))
40      (stgmsg "Interpreted")
41      (when (system-normal? (string-append csi " -s " fil))
42        (stgmsg "Compiled")
43        (parameterize ((compile-file-options csc-opt))
44          ;NOTE this exits due to 'test-exit'!
45          (compile-file fil) ) ) )
46    ;
47    ;NOTE when 'csi -s <script>' -> (program-name <script>) so must
48    ;determine w/ other means
49    ;
50    (let* ((args (argv) )
51           (csi (car args) ) )
52      (csi-n-csc TEST-SOURCE-FILE csi '("-O3" "-d2"))  ) )
53  ;
54  (else ;(windows ...)
55    ;
56    (include TEST-SOURCE-FILE) ) )
Note: See TracBrowser for help on using the repository browser.