Changeset 40504 in project


Ignore:
Timestamp:
09/09/21 00:05:01 (2 weeks ago)
Author:
Kon Lovett
Message:

updated slib-compat, new test runner

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

Legend:

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

    r39973 r40504  
    1515  (apply find args) )
    1616
    17 (define (remove-if. args)
     17(define (remove-if . args)
    1818  (import (only (srfi 1) remove))
    1919  (apply remove args) )
     
    4141(define output-port-height)
    4242(let ()
    43   (import (only (chicken port) terminal-size))
     43  (cond-expand
     44    ;terminal-size: "On Windows, this procedure always raises an exception."
     45    (windows
     46      (define (port-size port)
     47        (values 0 0) ) )
     48    (else
     49      (define (port-size port)
     50        (import (only (chicken port) terminal-size terminal-port?))
     51        (if (terminal-port? port) (terminal-size port) (values 0 0)) ) ) )
    4452  (set! output-port-width (lambda (port)
    45     (let-values (((h w) (terminal-size port)))
     53    (let-values (((h w) (port-size port)))
    4654      (if (zero? w) 80 w))))
    4755  (set! output-port-height (lambda (port)
    48     (let-values (((h w) (terminal-size port)))
     56    (let-values (((h w) (port-size port)))
    4957      (if (zero? h) 25 h)))) )
    5058
     
    5967        (kwd (string->keyword (symbol->string x)))
    6068        (fs (features)) )
    61         (and
    62           (cond
    63             ((memq kwd fs))
    64             ((and (memq x +numeric+) (memq #:full-numeric-tower fs)))
    65             ((memq x +builtins+))
    66             (else #f) )
    67             #t ) ) ) ) )
     69        (cond
     70          ((memq kwd fs))
     71          ((and (memq x +numeric+) (memq #:full-numeric-tower fs)))
     72          ((memq x +builtins+))
     73          (else #f) ) ) ) ) )
    6874
    6975(define (require x)
  • release/5/slib-prec/trunk/tests/run.scm

    r39829 r40504  
    77    make-pathname pathname-file pathname-replace-directory pathname-strip-extension)
    88  (only (chicken process) system)
    9   (only (chicken process-context) command-line-arguments)
     9  (only (chicken process-context) command-line-arguments get-environment-variable)
    1010  (only (chicken format) format)
    1111  (only (chicken file) file-exists? find-files)
     
    1313
    1414;; Globals
     15
     16(define *csi* (or (get-environment-variable "CHICKEN_CSI") "csi"))
     17(define *csc* (or (get-environment-variable "CHICKEN_CSC") "csc"))
    1518
    1619(define *csc-init-options* '(
     
    5356      (error 'run "cannot determine egg-name")) ) )
    5457
    55 (define (csc-options) (remove/list *csc-remv-options* *csc-init-options*))
     58(define (csc-options)
     59  (append *csc-incl-options* (remove/list *csc-excl-options* *csc-init-options*)) )
    5660
    5761(define (test-filename name) (string-append name "-test"))
     
    6468
    6569(define (test-files)
    66   (let ((remvs (map make-test-pathname *test-remv-names*)))
     70  (let ((remvs (map make-test-pathname *test-excl-names*)))
    6771    (find-files
    6872      *test-directory*
     
    7882
    7983(define (run-test-evaluated source)
    80   (format #t "*** csi ~A ***~%" (pathname-file source))
    81   (system-must (string-append "csi -s " source)) )
     84  (format #t "*** ~A ~A ***~%" *csi* (pathname-file source))
     85  (system-must (string-append *csi* " -s " source)) )
    8286
    8387(define (run-test-compiled source csc-options)
    8488  (let ((optstr (apply string-append (intersperse csc-options " "))))
    85     (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
     89    (format #t "*** ~A ~A ~A ***~%" *csc* (pathname-file source) optstr)
    8690    ;csc output is in current directory
    87     (system-must (string-append "csc" " " optstr " " source)) )
     91    (system-must (string-append *csc* " " optstr " " source)) )
    8892  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    8993
Note: See TracChangeset for help on using the changeset viewer.