Changeset 39828 in project


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

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

Location:
release/5/unitex-named-chars/trunk
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/unitex-named-chars/trunk/tests/run.scm

    r39028 r39828  
    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 "unitex-named-chars")
    8 (define HAS-LEXICAL #t)
     14;; Globals
    915
    10 ;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"))
    1122
    12 (import (only (chicken pathname)
    13   make-pathname pathname-file pathname-replace-directory pathname-strip-extension))
    14 (import (only (chicken process) system))
    15 (import (only (chicken process-context) argv))
    16 (import (only (chicken format) format))
    17 (import (only (chicken file) file-exists? find-files))
    18 (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*)))
    1926
    20 (define *args* (argv))
     27(include-relative "run-ident")
    2128
    22 (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))
    2349  (cond
    24     ((<= 4 (length *args*)) (cadddr *args*) )
    25     (def                    def )
     50    ((not (null? args)) (car args))
     51    (def                def)
    2652    (else
    27       (error 'run "cannot determine egg-name") ) ) )
     53      (error 'run "cannot determine egg-name")) ) )
    2854
    29 (define *current-directory* (cond-expand (unix "./") (else #f)))
    30 (define *egg* (egg-name *args*))
     55(define (csc-options)
     56  (append *csc-incl-options* (remove/list *csc-excl-options* *csc-init-options*)) )
    3157
    32 ;no -disable-interrupts or -no-lambda-info
    33 (define *csc-options* "-inline-global -local -inline \
    34   -specialize -optimize-leaf-routines -clustering -lfa2 \
    35   -no-trace -unsafe \
    36   -strict-types")
     58(define (test-filename name) (string-append name "-test"))
    3759
    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))
     60(define (make-test-pathname name)
     61  (make-pathname *test-directory* (test-filename name) *test-extension*) )
    4162
    42 (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)
    4374  (if (irregex-match? *test-files-rx* name)
    4475    name
    45     (make-pathname *current-directory* (test-filename name) "scm") ) )
     76    (make-test-pathname name)) )
     77
     78;; Run Tests
    4679
    4780(define (run-test-evaluated source)
    48   (let ((cmd "csi"))
    49     (when HAS-LEXICAL (set! cmd (string-append cmd " -R " EGG-NAME)))
    50     (set! cmd (string-append cmd " -s " source))
    51     (print "*** " cmd " ***")
    52     (system cmd) ) )
     81  (format #t "*** csi ~A ***~%" (pathname-file source))
     82  (system-must (string-append "csi -s " source)) )
    5383
    5484(define (run-test-compiled source csc-options)
    55   (let ((cmd "csc"))
    56     (when HAS-LEXICAL (set! cmd (string-append cmd " -X " EGG-NAME)))
    57     (set! cmd (string-append cmd " " csc-options " " source))
    58     (print "*** " cmd " ***")
    59     (system cmd)
     85  (let ((optstr (apply string-append (intersperse csc-options " "))))
     86    (format #t "*** csc ~A ~A ***~%" (pathname-file source) optstr)
    6087    ;csc output is in current directory
    61     (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) ) )
     88    (system-must (string-append "csc" " " optstr " " source)) )
     89  (system-must (pathname-replace-directory (pathname-strip-extension source) *test-directory*)) )
    6290
    63 ;;;
    64 
    65 (define (run-test #!optional (name *egg*) (csc-options *csc-options*))
    66   (let (
    67     (source (ensure-test-source-name name)) )
     91(define (run-test #!optional (name (egg-name)) (csc-options (csc-options)))
     92  (let ((source (ensure-test-pathname name)))
    6893    (unless (file-exists? source)
    6994      (error 'run "no such file" source) )
     
    7297    (run-test-compiled source csc-options) ) )
    7398
    74 (define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
     99(define (run-tests #!optional (tests (test-files)) (csc-options (csc-options)))
    75100  (for-each (cut run-test <> csc-options) tests) )
    76101
    77 ;;; Do Test
     102;; Do Tests
    78103
    79104(run-tests)
  • release/5/unitex-named-chars/trunk/tests/unitex-named-chars-test.scm

    r39029 r39828  
    2121(test #x1F699 (char->integer (char-name '|:blue_car:|)))
    2222
     23;--> ????  -- umm, yeah, ?????
    2324(gloss #\:no_pedestrians: #\Vdash #\:smoking: #\:speedboat:)
    2425
  • release/5/unitex-named-chars/trunk/unitex-named-chars.egg

    r39028 r39828  
    55 (version "0.0.1")
    66 (category misc)
    7  (author "[[kon lovett]]")
     7 (author "Kon Lovett")
    88 (license "BSD")
    99 (dependencies)
Note: See TracChangeset for help on using the changeset viewer.