Changeset 39829 in project


Ignore:
Timestamp:
04/04/21 02:27:45 (5 weeks ago)
Author:
Kon Lovett
Message:

fix test runner fail exit pass-thru, add test runner config

Location:
release/5/slib-prec/trunk
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/slib-prec/trunk/slib-prec-parse.scm

    r38718 r39829  
    1111  ;
    1212  syntax-end!                 ; (set! *syn-defs* '())   => (syntax-end!)
    13   syntax-begin!               ; (set! *syn-def* ...)    => (syntax-begin! ...)
     13  syntax-begin!               ; (set! *syn-defs* ...)   => (syntax-begin! ...)
    1414  syntax-current              ; *syn-def*               => (syntax-current)
    1515  syntax-ignore-whitespace    ; *syn-ignore-whitespace* => (syntax-ignore-whitespace)
  • release/5/slib-prec/trunk/tests/run.scm

    r38980 r39829  
    1 ;;;; run.scm -*- Scheme -*-
     1;;;; run.scm  -*- Scheme -*-
    22
    3 (import scheme)
     3;chicken-install invokes as "<csi> -s run.scm <eggnam>"
    44
    5 ;;; Create Egg Const
     5(import scheme
     6  (only (chicken pathname)
     7    make-pathname pathname-file pathname-replace-directory pathname-strip-extension)
     8  (only (chicken process) system)
     9  (only (chicken process-context) command-line-arguments)
     10  (only (chicken format) format)
     11  (only (chicken file) file-exists? find-files)
     12  (only (chicken irregex) irregex irregex-match?))
    613
    7 (define EGG-NAME "slib-prec")
     14;; Globals
    815
    9 ;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
     16(define *csc-init-options* '(
     17  ;"-disable-interrupts"
     18  "-inline-global" "-inline" "-local"
     19  "-specialize" "-strict-types"
     20  "-optimize-leaf-routines" "-clustering" "-lfa2"
     21  "-no-trace" "-no-lambda-info" "-unsafe"))
    1022
    11 (import (only (chicken pathname)
    12   make-pathname pathname-file pathname-replace-directory pathname-strip-extension))
    13 (import (only (chicken process) system))
    14 (import (only (chicken process-context) argv))
    15 (import (only (chicken format) format))
    16 (import (only (chicken file) file-exists? find-files))
    17 (import (only (chicken irregex) irregex irregex-match?))
     23(define *test-directory* ".")
     24(define *test-extension* "scm")
     25(define *test-files-rx* (irregex `(: (+ graph) #\- "test" #\. ,*test-extension*)))
    1826
    19 (define *args* (argv))
     27(include-relative "run-ident")
    2028
    21 (define (egg-name args #!optional (def EGG-NAME))
     29;; Support
     30
     31(define (system-must cmd)
     32  (let ((stat (system cmd)))
     33    (if (zero? stat) 0
     34      ;failed, actual code irrelevant
     35      (exit 1) ) ) )
     36
     37(define (remove rmv? ls)
     38  (let loop ((ls ls) (os '()))
     39    (cond
     40      ((null? ls)       (reverse os))
     41      ((rmv? (car ls))  (loop (cdr ls) os))
     42      (else             (loop (cdr ls) (cons (car ls) os))) ) ) )
     43
     44(define (remove/list os ls) (remove (cut member <> os) ls))
     45
     46;; Test Run Support
     47
     48(define (egg-name #!optional (args (command-line-arguments)) (def EGG-NAME))
    2249  (cond
    23     ((<= 4 (length *args*)) (cadddr *args*) )
    24     (def                    def )
     50    ((not (null? args)) (car args))
     51    (def                def)
    2552    (else
    26       (error 'run "cannot determine egg-name") ) ) )
     53      (error 'run "cannot determine egg-name")) ) )
    2754
    28 (define *current-directory* (cond-expand (unix "./") (else #f)))
    29 (define *egg* (egg-name *args*))
     55(define (csc-options) (remove/list *csc-remv-options* *csc-init-options*))
    3056
    31 ;no -disable-interrupts or -no-lambda-info
    32 ;no -local
    33 (define *csc-options* "-inline-global -inline \
    34   -specialize -optimize-leaf-routines -clustering -lfa2 \
    35   -no-trace -unsafe \
    36   -strict-types")
     57(define (test-filename name) (string-append name "-test"))
    3758
    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))
     59(define (make-test-pathname name)
     60  (make-pathname *test-directory* (test-filename name) *test-extension*) )
    4161
    42 (define (ensure-test-source-name name)
     62(define (matching-test-file? x #!optional (remvs '()))
     63  (and (irregex-match? *test-files-rx* x) (not (member x remvs))) )
     64
     65(define (test-files)
     66  (let ((remvs (map make-test-pathname *test-remv-names*)))
     67    (find-files
     68      *test-directory*
     69      #:test (cut matching-test-file? <> remvs)
     70      #:limit 0) ) )
     71
     72(define (ensure-test-pathname name)
    4373  (if (irregex-match? *test-files-rx* name)
    4474    name
    45     (make-pathname *current-directory* (test-filename name) "scm") ) )
     75    (make-test-pathname name)) )
     76
     77;; Run Tests
    4678
    4779(define (run-test-evaluated source)
    48   (format #t "*** ~A - csi ***~%" (pathname-file source))
    49   (system (string-append "csi -s " source)) )
     80  (format #t "*** csi ~A ***~%" (pathname-file source))
     81  (system-must (string-append "csi -s " source)) )
    5082
    5183(define (run-test-compiled source csc-options)
    52   (format #t "*** ~A - csc ~A ***~%" (pathname-file source) csc-options)
    53   ;csc output is in current directory
    54   (system (string-append "csc" " " csc-options " " source))
    55   (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
     84  (let ((optstr (apply string-append (intersperse csc-options " "))))
     85    (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
     86    ;csc output is in current directory
     87    (system-must (string-append "csc" " " optstr " " source)) )
     88  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    5689
    57 ;;;
    58 
    59 (define (run-test #!optional (name *egg*) (csc-options *csc-options*))
    60   (let (
    61     (source (ensure-test-source-name name)) )
     90(define (run-test #!optional (name (egg-name)) (csc-options (csc-options)))
     91  (let ((source (ensure-test-pathname name)))
    6292    (unless (file-exists? source)
    6393      (error 'run "no such file" source) )
     
    6696    (run-test-compiled source csc-options) ) )
    6797
    68 (define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
     98(define (run-tests #!optional (tests (test-files)) (csc-options (csc-options)))
    6999  (for-each (cut run-test <> csc-options) tests) )
    70100
    71 ;;; Do Test
     101;; Do Tests
    72102
    73103(run-tests)
Note: See TracChangeset for help on using the changeset viewer.