Ignore:
Timestamp:
04/01/20 02:28:30 (8 months ago)
Author:
Kon Lovett
Message:

update runner, optimization

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/tiger-hash/trunk/tests/run.scm

    r35880 r38447  
     1;;;; run.scm -*- Scheme -*-
     2
     3(import scheme)
     4
     5;;; Create Egg Const
    16
    27(define EGG-NAME "tiger-hash")
     
    49;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    510
    6 (import
    7   (only (chicken pathname) make-pathname)
    8   (only (chicken process) system)
    9   (only (chicken process-context) argv)
    10   (only (chicken format) format))
     11(import (only (chicken pathname) make-pathname))
     12(import (only (chicken process) system))
     13(import (only (chicken process-context) argv))
     14(import (only (chicken format) format))
    1115
    12 (define *args* (argv))
     16(define (test-filename test-name)
     17  (string-append test-name "-test") )
    1318
    14 ;no -disable-interrupts
    15 (define *csc-options* "-inline-global \
    16   -specialize -optimize-leaf-routines -clustering -lfa2 \
    17   -local -inline \
    18   -no-trace -no-lambda-info \
    19   -unsafe")
    20 
    21 (define (test-name #!optional (eggnam EGG-NAME))
    22   (string-append eggnam "-test") )
    23 
    24 (define (egg-name #!optional (def EGG-NAME))
     19(define (egg-name args #!optional (def EGG-NAME))
    2520  (cond
    2621    ((<= 4 (length *args*))
     
    3126      (error 'test "cannot determine egg-name") ) ) )
    3227
    33 ;;;
     28;;
    3429
    35 (set! EGG-NAME (egg-name))
     30(define *args* (argv))
     31(define *egg* (egg-name *args*))
     32(define *tests* `(,*egg*))
    3633
    37 (define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    38   (let ((tstnam (test-name eggnam)))
    39     (format #t "*** csi ***~%")
    40     (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    41     (newline)
    42     (format #t "*** csc ~s ***~%" cscopts)
    43     (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    44     (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     34(define *current-directory* (cond-expand (unix "./") (else #f)))
    4535
    46 (define (run-tests eggnams #!optional (cscopts *csc-options*))
    47   (for-each (cut run-test <> cscopts) eggnams) )
     36;no -disable-interrupts or -no-lambda-info
     37(define *csc-options* "-inline-global -local -inline \
     38  -specialize -optimize-leaf-routines -clustering -lfa2 \
     39  -no-trace -unsafe")
     40
     41(define (run-test-evaluated test-name test-source)
     42  (format #t "*** ~A - csi ***~%" test-name)
     43  (system (string-append "csi -s " test-source)) )
     44
     45(define (run-test-compiled test-name test-source csc-options)
     46  (format #t "*** ~A - csc ~A ***~%" test-name csc-options)
     47  ;csc output is in current directory
     48  (system (string-append "csc" " " csc-options " " test-source))
     49  (system (make-pathname *current-directory* (test-filename test-name))) )
    4850
    4951;;;
    5052
    51 (run-test)
     53(define (run-test #!optional (test-name *egg*) (csc-options *csc-options*))
     54  (let ((test-source (make-pathname #f (test-filename test-name) "scm")))
     55    (run-test-evaluated test-name test-source)
     56    (newline)
     57    (run-test-compiled test-name test-source csc-options) ) )
     58
     59(define (run-tests #!optional (test-names *tests*) (csc-options *csc-options*))
     60  (for-each (cut run-test <> csc-options) test-names) )
     61
     62;;; Do Test
     63
     64(run-tests)
Note: See TracChangeset for help on using the changeset viewer.