Changeset 39694 in project for release/5/stack/trunk/tests/run.scm


Ignore:
Timestamp:
03/13/21 22:10:44 (8 weeks ago)
Author:
Kon Lovett
Message:

remove "primitives", use record-variants, add hof tests, new test runner

File:
1 edited

Legend:

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

    r38630 r39694  
    33(import scheme)
    44
    5 ;;; Create Egg Const
     5;; Create Egg Const
    66
    7 (define EGG-NAME "stack")
     7(include-relative "run-ident")
    88
    99;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
     
    1818
    1919(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")))
    2025
    21 (define (egg-name args #!optional (def EGG-NAME))
     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) ) ) ) )
     39
     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)) ) ) ) )
     47
     48(define (egg-name #!optional (args *args*) (def EGG-NAME))
    2249  (cond
    2350    ((<= 4 (length *args*)) (cadddr *args*) )
     
    2653      (error 'run "cannot determine egg-name") ) ) )
    2754
    28 (define *current-directory* (cond-expand (unix "./") (else #f)))
    29 (define *egg* (egg-name *args*))
     55(define (as-csc-options ls)
     56  (apply string-append (intersperse (map symbol->string ls) " ")) )
    3057
    31 ;no -disable-interrupts or -no-lambda-info
    32 (define *csc-options* "-inline-global -local -inline \
    33   -specialize -optimize-leaf-routines -clustering -lfa2 \
    34   -no-trace -unsafe \
    35   -strict-types")
     58(define (csc-options)
     59  (as-csc-options (remqs *csc-remv-options* *csc-init-options*)) )
    3660
    37 (define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
    3861(define (test-filename name) (string-append name "-test"))
     62
    3963(define (test-files) (find-files "." #:test *test-files-rx* #:limit 1))
    4064
     
    4367    name
    4468    (make-pathname *current-directory* (test-filename name) "scm") ) )
     69
     70;;
    4571
    4672(define (run-test-evaluated source)
     
    5480  (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
    5581
    56 ;;;
    57 
    58 (define (run-test #!optional (name *egg*) (csc-options *csc-options*))
     82(define (run-test #!optional (name (egg-name)) (csc-options (csc-options)))
    5983  (let (
    6084    (source (ensure-test-source-name name)) )
     
    6589    (run-test-compiled source csc-options) ) )
    6690
    67 (define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
     91(define (run-tests #!optional (tests (test-files)) (csc-options (csc-options)))
    6892  (for-each (cut run-test <> csc-options) tests) )
    6993
    70 ;;; Do Test
     94;; Do Test
    7195
    7296(run-tests)
Note: See TracChangeset for help on using the changeset viewer.