Changeset 38501 in project


Ignore:
Timestamp:
04/01/20 20:00:52 (4 months ago)
Author:
Kon Lovett
Message:

*-test runner, appropriate optimization for rt type-checks, style

Location:
release/5/stack/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/stack/trunk/stack.egg

    r37621 r38501  
    33
    44((synopsis "Provides LIFO queue (stack) operations")
    5  (version "3.0.2")
     5 (version "3.0.3")
    66 (category data)
    77 (author "[[kon lovett]]")
     
    1212 (components
    1313  (extension stack
    14     #;(inline-file)
    1514    (types-file)
    16     (csc-options "-O3" "-d1" "-local" "-no-procedure-checks" "-inline-limit" "50") ) ) )
     15    (csc-options "-O3" "-d1" "-local" "-no-procedure-checks" "-no-bound-checks") ) ) )
  • release/5/stack/trunk/stack.scm

    r37621 r38501  
    3434  stack-literal-form)
    3535
    36 (import scheme
    37   (srfi 10)
    38   (chicken base)
    39   (chicken fixnum)
    40   (chicken type)
    41   (only (chicken port) with-output-to-port)
    42   (only (chicken format) format)
    43   (only type-errors define-error-type error-list error-fixnum))
     36(import scheme)
     37(import (srfi 10))
     38(import (chicken base))
     39(import (chicken fixnum))
     40(import (chicken type))
     41(import (only (chicken port) with-output-to-port))
     42(import (only (chicken format) format))
     43(import (only type-errors define-error-type error-list error-fixnum))
    4444
    4545(include "chicken-primitive-object-inlines")
  • release/5/stack/trunk/tests/run.scm

    r37621 r38501  
     1;;;; run.scm -*- Scheme -*-
     2
     3(import scheme)
     4
     5;;; Create Egg Const
    16
    27(define EGG-NAME "stack")
     
    49;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    510
    6 (import
    7   (only (chicken pathname) make-pathname)
    8   (only (chicken process) system)
    9   (only (chicken process-context) argv)
    10   (only (chicken format) format))
     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?))
    1118
    1219(define *args* (argv))
    1320
    14 ;no -disable-interrupts
    15 #;(define *csc-options* "-inline-global \
     21(define (egg-name args #!optional (def EGG-NAME))
     22  (cond
     23    ((<= 4 (length *args*)) (cadddr *args*) )
     24    (def                    def )
     25    (else
     26      (error 'run "cannot determine egg-name") ) ) )
     27
     28(define *current-directory* (cond-expand (unix "./") (else #f)))
     29(define *egg* (egg-name *args*))
     30
     31;no -disable-interrupts or -no-lambda-info
     32(define *csc-options* "-inline-global -local -inline \
    1633  -specialize -optimize-leaf-routines -clustering -lfa2 \
    17   -local -inline \
    18   -no-trace -no-lambda-info")
    19 (define *csc-options* "-O3 -d1 -local")
     34  -no-trace -unsafe")
    2035
    21 (define (test-name #!optional (eggnam EGG-NAME))
    22   (string-append eggnam "-test") )
     36(define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
     37(define (test-filename name) (string-append name "-test"))
     38(define (test-files) (find-files "." #:test *test-files-rx* #:limit 1))
    2339
    24 (define (egg-name #!optional (def EGG-NAME))
    25   (cond
    26     ((<= 4 (length *args*))
    27       (cadddr *args*) )
    28     (def
    29       def )
    30     (else
    31       (error 'test "cannot determine egg-name") ) ) )
     40(define (ensure-test-source-name name)
     41  (if (irregex-match? *test-files-rx* name)
     42    name
     43    (make-pathname *current-directory* (test-filename name) "scm") ) )
     44
     45(define (run-test-evaluated source)
     46  (format #t "*** ~A - csi ***~%" (pathname-file source))
     47  (system (string-append "csi -s " source)) )
     48
     49(define (run-test-compiled source csc-options)
     50  (format #t "*** ~A - csc ~A ***~%" (pathname-file source) csc-options)
     51  ;csc output is in current directory
     52  (system (string-append "csc" " " csc-options " " source))
     53  (system (pathname-replace-directory (pathname-strip-extension source) *current-directory*)) )
    3254
    3355;;;
    3456
    35 (set! EGG-NAME (egg-name))
     57(define (run-test #!optional (name *egg*) (csc-options *csc-options*))
     58  (let (
     59    (source (ensure-test-source-name name)) )
     60    (unless (file-exists? source)
     61      (error 'run "no such file" source) )
     62    (run-test-evaluated source)
     63    (newline)
     64    (run-test-compiled source csc-options) ) )
    3665
    37 (define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    38   (let ((tstnam (test-name eggnam)))
    39     (format #t "*** csi ***~%")
    40     (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    41     (newline)
    42     (format #t "*** csc ~s ***~%" cscopts)
    43     (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    44     (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     66(define (run-tests #!optional (tests (test-files)) (csc-options *csc-options*))
     67  (for-each (cut run-test <> csc-options) tests) )
    4568
    46 (define (run-tests eggnams #!optional (cscopts *csc-options*))
    47   (for-each (cut run-test <> cscopts) eggnams) )
     69;;; Do Test
    4870
    49 ;;;
    50 
    51 (run-test)
     71(run-tests)
Note: See TracChangeset for help on using the changeset viewer.