Changeset 39821 in project


Ignore:
Timestamp:
04/04/21 02:09:12 (3 weeks ago)
Author:
Kon Lovett
Message:

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

Location:
release/5/stack/trunk/tests
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/stack/trunk/tests/run-ident.scm

    r39694 r39821  
    22
    33(define EGG-NAME "stack")
    4 (define *csc-remv-options* '())
     4(define *csc-incl-options* '())
     5(define *csc-excl-options* '())
     6(define *test-excl-names* '())
  • release/5/stack/trunk/tests/run.scm

    r39694 r39821  
    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?))
     13
     14;; Globals
     15
     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"))
     22
     23(define *test-directory* ".")
     24(define *test-extension* "scm")
     25(define *test-files-rx* (irregex `(: (+ graph) #\- "test" #\. ,*test-extension*)))
    626
    727(include-relative "run-ident")
    828
    9 ;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
     29;; Support
    1030
    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?))
     31(define (system-must cmd)
     32  (let ((stat (system cmd)))
     33    (if (zero? stat) 0
     34      ;failed, actual code irrelevant
     35      (exit 1) ) ) )
    1836
    19 (define *args* (argv))
    20 (define *current-directory* (cond-expand (unix "./") (else #f)))
    21 ;no -disable-interrupts or -no-lambda-info
    22 (define *csc-init-options* '(-inline-global -local -inline -specialize
    23   -optimize-leaf-routines -clustering -lfa2 -no-trace -unsafe -strict-types))
    24 (define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
     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))) ) ) )
    2543
    26 (define (remq obj ls)
    27   (let loop ((curr ls) (prev '()))
    28     (cond
    29       ((null? curr)
    30         ls )
    31       ((eq? obj (car curr))
    32         (if (null? prev)
    33           (cdr ls)
    34           (begin
    35             (set-cdr! prev (cdr curr))
    36             ls ) ) )
    37       (else
    38         (loop (cdr curr) curr) ) ) ) )
     44(define (remove/list os ls) (remove (cut member <> os) ls))
    3945
    40 (define (remqs os ls)
    41   (let loop ((ls ls) (os os))
    42     (cond
    43       ((null? os)
    44         ls )
    45       (else
    46         (loop (remq (car os) ls) (cdr os)) ) ) ) )
     46;; Test Run Support
    4747
    48 (define (egg-name #!optional (args *args*) (def EGG-NAME))
     48(define (egg-name #!optional (args (command-line-arguments)) (def EGG-NAME))
    4949  (cond
    50     ((<= 4 (length *args*)) (cadddr *args*) )
    51     (def                    def )
     50    ((not (null? args)) (car args))
     51    (def                def)
    5252    (else
    53       (error 'run "cannot determine egg-name") ) ) )
    54 
    55 (define (as-csc-options ls)
    56   (apply string-append (intersperse (map symbol->string ls) " ")) )
     53      (error 'run "cannot determine egg-name")) ) )
    5754
    5855(define (csc-options)
    59   (as-csc-options (remqs *csc-remv-options* *csc-init-options*)) )
     56  (append *csc-incl-options* (remove/list *csc-excl-options* *csc-init-options*)) )
    6057
    6158(define (test-filename name) (string-append name "-test"))
    6259
    63 (define (test-files) (find-files "." #:test *test-files-rx* #:limit 1))
     60(define (make-test-pathname name)
     61  (make-pathname *test-directory* (test-filename name) *test-extension*) )
    6462
    65 (define (ensure-test-source-name name)
     63(define (matching-test-file? x #!optional (remvs '()))
     64  (and (irregex-match? *test-files-rx* x) (not (member x remvs))) )
     65
     66(define (test-files)
     67  (let ((remvs (map make-test-pathname *test-excl-names*)))
     68    (find-files
     69      *test-directory*
     70      #:test (cut matching-test-file? <> remvs)
     71      #:limit 0) ) )
     72
     73(define (ensure-test-pathname name)
    6674  (if (irregex-match? *test-files-rx* name)
    6775    name
    68     (make-pathname *current-directory* (test-filename name) "scm") ) )
     76    (make-test-pathname name)) )
    6977
    70 ;;
     78;; Run Tests
    7179
    7280(define (run-test-evaluated source)
    73   (format #t "*** ~A - csi ***~%" (pathname-file source))
    74   (system (string-append "csi -s " source)) )
     81  (format #t "*** csi ~A ***~%" (pathname-file source))
     82  (system-must (string-append "csi -s " source)) )
    7583
    7684(define (run-test-compiled source csc-options)
    77   (format #t "*** ~A - csc ~A ***~%" (pathname-file source) csc-options)
    78   ;csc output is in current directory
    79   (system (string-append "csc" " " csc-options " " source))
    80   (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
     85  (let ((optstr (apply string-append (intersperse csc-options " "))))
     86    (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
     87    ;csc output is in current directory
     88    (system-must (string-append "csc" " " optstr " " source)) )
     89  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    8190
    8291(define (run-test #!optional (name (egg-name)) (csc-options (csc-options)))
    83   (let (
    84     (source (ensure-test-source-name name)) )
     92  (let ((source (ensure-test-pathname name)))
    8593    (unless (file-exists? source)
    8694      (error 'run "no such file" source) )
     
    92100  (for-each (cut run-test <> csc-options) tests) )
    93101
    94 ;; Do Test
     102;; Do Tests
    95103
    96104(run-tests)
Note: See TracChangeset for help on using the changeset viewer.