Changeset 39677 in project

Timestamp:

03/12/21 16:48:38 (6 weeks ago)

Author:

Kon Lovett

Message:

test runner w/ csc option remove, no test dep, add time to tests

Location:

release/5/srfi-45/trunk

Files:

• srfi-45.egg (modified) (1 diff)
• tests/run.scm (modified) (3 diffs)
• tests/srfi-45-test.scm (modified) (10 diffs)

release/5/srfi-45/trunk/srfi-45.egg

@@ -2 +2 @@
 
 ((synopsis "SRFI-45: Primitives for Expressing Iterative Lazy Algorithms")
- (version "4.0.2")
+ (version "4.0.3")
  (category lang-exts)
  (author "André van Tonder, for Chicken 4 by Kon Lovett, for Chicken 5 by [[Sergey Goldgaber]]")
  (maintainer "Kon Lovett")
  (dependencies check-errors)
- (test-dependencies test)
  (license "BSD")
  (components

release/5/srfi-45/trunk/tests/run.scm

@@ -6 +6 @@
 
 (define EGG-NAME "srfi-45")
-
-;! no -strict-types 4 srfi-45 !
-;no -disable-interrupts or -no-lambda-info
-(define *csc-options* "-inline-global -local -inline \
-  -specialize -optimize-leaf-routines -clustering -lfa2 \
-  -no-trace -unsafe")
+;rebinding by tests
+(define *csc-remv-options* '(-strict-types))
 
 ;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
@@ -23 +19 @@
 (import (only (chicken irregex) irregex irregex-match?))
 
+(define (remq obj ls)
+  (let loop ((curr ls) (prev '()))
+    (cond
+      ((null? curr)
+        ls )
+      ((eq? obj (car curr))
+        (if (null? prev)
+          (cdr ls)
+          (begin
+            (set-cdr! prev (cdr curr))
+            ls ) ) )
+      (else
+        (loop (cdr curr) curr) ) ) ) )
+
+(define (remqs os ls)
+  (let loop ((ls ls) (os os))
+    (cond
+      ((null? os)
+        ls )
+      (else
+        (loop (remq (car os) ls) (cdr os)) ) ) ) )
+
 (define *args* (argv))
 
@@ -32 +50 @@
       (error 'run "cannot determine egg-name") ) ) )
 
+(define (as-csc-options ls)
+  (apply string-append (intersperse (map symbol->string ls) " ")) )
+
 (define *current-directory* (cond-expand (unix "./") (else #f)))
 (define *egg* (egg-name *args*))
+
+;no -disable-interrupts or -no-lambda-info
+(define *csc-init-options* '(-inline-global -local -inline
+  -specialize -optimize-leaf-routines -clustering -lfa2
+  -no-trace -unsafe -strict-types))
+
+(define *csc-options* (as-csc-options (remqs *csc-remv-options* *csc-init-options*)))
 
 (define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))

release/5/srfi-45/trunk/tests/srfi-45-test.scm

@@ -17 +17 @@
       (begin
         (print "+++ Bounded Space Test: (force " '?expr ") +++")
-        (force ?expr) ) ) ) )
+        (time (force ?expr)) ) ) ) )
 
 (define-syntax -bounded-space
@@ -33 +33 @@
 (print "+++ Should print 'hi 1 +++")
 
+(time
 (define r (r5rs:delay (begin (display 'hi) (display #\space) 1)))
 (define s (lazy r))
 (define t (lazy s))
 (print (force t))
+)
 
 ;=========================================================================
@@ -43 +45 @@
 (print "+++ Should print '(1 2 3) +++")
 
+(time
 (define r (delay (values 1 2 3)))
 (define s (lazy r))
 (define t (lazy s))
 (print (receive (force t)))
+)
 
 ;=========================================================================
@@ -55 +59 @@
 (define s (delay (begin (print 'hello) 1)))
 
+(time
 (force s)
 (force s)
+)
 
 ;=========================================================================
@@ -63 +69 @@
 (print "+++ Should print 'bonjour once +++")
 
+(time
 (let ((s (delay (begin (print 'bonjour) 2))))
   (+ (force s) (force s)))
+)
 
 ;=========================================================================
@@ -75 +83 @@
 (define t (lazy s))
 
+(time
 (force t)
 (force r)
+)
 
 ;=========================================================================
@@ -94 +104 @@
 (define s (ones))
 
+(time
 (car (force (stream-drop s 4)))
 (car (force (stream-drop s 4)))
+)
 
 ;=========================================================================
@@ -109 +121 @@
                (force p)))))
 (define x 5)
+
+(time
 (print (force p))
 (set! x 10)
 (print (force p))
-
+)
 
 ;=========================================================================
@@ -126 +140 @@
                  (force f))))))
 
+(time
 (print (force f))
+)
 
 ;=========================================================================
@@ -147 +163 @@
 (define p (cadr q))
 
+(time
 (print (get-count))
 (print (force p))
 (print (get-count))
+)
 
 ;=========================================================================