Changeset 39678 in project


Ignore:
Timestamp:
03/12/21 17:40:03 (6 weeks ago)
Author:
Kon Lovett
Message:

separation of concerns, fewer globals

Location:
release/5/srfi-45/trunk/tests
Files:
1 added
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/srfi-45/trunk/tests/run.scm

    r39677 r39678  
    33(import scheme)
    44
    5 ;;; Create Egg Const
     5;; Create Egg Const
    66
    7 (define EGG-NAME "srfi-45")
    8 ;rebinding by tests
    9 (define *csc-remv-options* '(-strict-types))
     7(include-relative "run-ident")
    108
    119;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
     
    1816(import (only (chicken file) file-exists? find-files))
    1917(import (only (chicken irregex) irregex irregex-match?))
     18
     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")))
    2025
    2126(define (remq obj ls)
     
    4146        (loop (remq (car os) ls) (cdr os)) ) ) ) )
    4247
    43 (define *args* (argv))
    44 
    45 (define (egg-name args #!optional (def EGG-NAME))
     48(define (egg-name #!optional (args *args*) (def EGG-NAME))
    4649  (cond
    4750    ((<= 4 (length *args*)) (cadddr *args*) )
     
    5356  (apply string-append (intersperse (map symbol->string ls) " ")) )
    5457
    55 (define *current-directory* (cond-expand (unix "./") (else #f)))
    56 (define *egg* (egg-name *args*))
     58(define (csc-options)
     59  (as-csc-options (remqs *csc-remv-options* *csc-init-options*)) )
    5760
    58 ;no -disable-interrupts or -no-lambda-info
    59 (define *csc-init-options* '(-inline-global -local -inline
    60   -specialize -optimize-leaf-routines -clustering -lfa2
    61   -no-trace -unsafe -strict-types))
     61(define (test-filename name) (string-append name "-test"))
    6262
    63 (define *csc-options* (as-csc-options (remqs *csc-remv-options* *csc-init-options*)))
    64 
    65 (define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
    66 (define (test-filename name) (string-append name "-test"))
    6763(define (test-files) (find-files "." #:test *test-files-rx* #:limit 1))
    6864
     
    7167    name
    7268    (make-pathname *current-directory* (test-filename name) "scm") ) )
     69
     70;;
    7371
    7472(define (run-test-evaluated source)
     
    8280  (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
    8381
    84 ;;;
    85 
    86 (define (run-test #!optional (name *egg*) (csc-options *csc-options*))
     82(define (run-test #!optional (name (egg-name)) (csc-options (csc-options)))
    8783  (let (
    8884    (source (ensure-test-source-name name)) )
     
    9389    (run-test-compiled source csc-options) ) )
    9490
    95 (define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
     91(define (run-tests #!optional (tests (test-files)) (csc-options (csc-options)))
    9692  (for-each (cut run-test <> csc-options) tests) )
    9793
    98 ;;; Do Test
     94;; Do Test
    9995
    10096(run-tests)
Note: See TracChangeset for help on using the changeset viewer.