Changeset 37390 in project


Ignore:
Timestamp:
03/17/19 01:02:49 (20 months ago)
Author:
Kon Lovett
Message:

new style test runner

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/tests/run.scm

    r37132 r37390  
     1;;;; run.scm -*- Scheme -*-
     2
     3(import scheme)
     4
     5;;; Create Time Const
    16
    27(define EGG-NAME "apropos")
     
    1015  (only (chicken format) format))
    1116
    12 (define *args* (argv))
     17(define (test-filename test-name)
     18  (string-append test-name "-test") )
    1319
    14 ;no -disable-interrupts or -no-lambda-info
    15 (define *csc-options* "-inline-global -local -inline \
    16   -specialize -optimize-leaf-routines -clustering -lfa2 \
    17   -no-trace -unsafe")
    18 
    19 (define (test-name #!optional (eggnam EGG-NAME))
    20   (string-append eggnam "-test") )
    21 
    22 (define (egg-name #!optional (def EGG-NAME))
     20(define (egg-name args #!optional (def EGG-NAME))
    2321  (cond
    2422    ((<= 4 (length *args*))
     
    2927      (error 'test "cannot determine egg-name") ) ) )
    3028
    31 ;;;
     29;;
    3230
    33 (set! EGG-NAME (egg-name))
     31(define *args* (argv))
     32(define *egg* (egg-name *args*))
     33(define *tests* `(,*egg*))
    3434
    35 (define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    36   (let ((tstnam (test-name eggnam)))
    37     (format #t "*** csi ***~%")
    38     (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    39     (newline)
    40     (format #t "*** csc ~s ***~%" cscopts)
    41     (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    42     (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     35(define *current-directory* (cond-expand (unix "./") (else #f)))
    4336
    44 (define (run-tests eggnams #!optional (cscopts *csc-options*))
    45   (for-each (cut run-test <> cscopts) eggnams) )
     37;no -disable-interrupts or -no-lambda-info
     38(define *csc-options* "-inline-global -local -inline \
     39  -specialize -optimize-leaf-routines -clustering -lfa2 \
     40  -no-trace -unsafe")
     41
     42(define (run-test-evaluated test-name test-source)
     43  (format #t "*** ~A - csi ***~%" test-name)
     44  (system (string-append "csi -s " test-source)) )
     45
     46(define (run-test-compiled test-name test-source csc-options)
     47  (format #t "*** ~A - csc ~A ***~%" test-name csc-options)
     48  ;csc output is in current directory
     49  (system (string-append "csc" " " csc-options " " test-source))
     50  (system (make-pathname *current-directory* (test-filename test-name))) )
    4651
    4752;;;
    4853
    49 (run-test)
     54(define (run-test #!optional (test-name *egg*) (csc-options *csc-options*))
     55  (let ((test-source (make-pathname #f (test-filename test-name) "scm")))
     56    (run-test-evaluated test-name test-source)
     57    (newline)
     58    (run-test-compiled test-name test-source csc-options) ) )
     59
     60(define (run-tests #!optional (test-names *tests*) (csc-options *csc-options*))
     61  (for-each (cut run-test <> csc-options) test-names) )
     62
     63;;; Do Test
     64
     65(run-tests)
Note: See TracChangeset for help on using the changeset viewer.