Changeset 38612 in project for release

Timestamp:

04/11/20 17:25:43 (10 months ago)

Author:

juergen

Message:

simple-tests-2.0.3 state-changing functions now accepted

Location:

release/5/simple-tests

Files:

• tags/2.0.3 (copied) (copied from release/5/simple-tests/trunk)
• tags/2.0.3/simple-tests.egg (modified) (1 diff)
• tags/2.0.3/simple-tests.scm (modified) (4 diffs)
• tags/2.0.3/tests/run.scm (modified) (1 diff)
• trunk/simple-tests.egg (modified) (1 diff)
• trunk/simple-tests.scm (modified) (4 diffs)
• trunk/tests/run.scm (modified) (1 diff)

release/5/simple-tests/tags/2.0.3/simple-tests.egg

@@ -4 +4 @@
  (category testing)
  (license "BSD")
- (version "2.0.2")
+ (version "2.0.3")
  (author "Juergen Lorenz")
  (components (extension simple-tests

release/5/simple-tests/tags/2.0.3/simple-tests.scm

@@ -368 +368 @@
             (args* (cddadr form))
             (pairs* (cddr form))
+            (%x (rename 'x))
             (%tests (rename 'tests))
             (%writeln (rename 'writeln))
@@ -420 +421 @@
           ,@(map (lambda (p)
                    `(,%begin
-                      (,%when ,verbose?
-                        (,%print "testing " ',(car p) " ...")
-                        ;;(,%writeln 'computed ,(car p))
-                        (,%print* "computed: ") (,%writeln ,(car p))
-                        ;;(,%writeln 'expected ,(cadr p))
-                        (,%print* "expected: ") (,%writeln ,(cadr p))
-                        )
-                      (,%set! ,%tests
-                              ;(,%cons (,%cons ,(cons %equal? p) ',(car p)) ; ok
-                              (,%cons (,%cons ((,%== ,(car p)) ,(cadr p)) ',(car p))
-                                      ,%tests))
-                      ))
+                      (,%let ((,%x ,(car p)))
+                         ; protect against functions changing state
+                        (,%when ,verbose?
+                          (,%print "testing " ',(car p) " ...")
+                          ;(,%print* "computed: ") (,%writeln ,(car p))
+                          (,%print* "computed: ") (,%writeln ,%x)
+                          (,%print* "expected: ") (,%writeln ,(cadr p))
+                          )
+                        (,%set! ,%tests
+                                ;(,%cons (,%cons ,(cons %equal? p) ',(car p)) ; ok
+                                ;(,%cons (,%cons ((,%== ,(car p)) ,(cadr p)) ',(car p))
+                                (,%cons (,%cons ((,%== ,%x) ,(cadr p)) ',(car p))
+                                        ,%tests)))
+                        ))
                  (chop pairs* 2))
           (,%let ((,%fails (,select-failures (,%reverse ,%tests))))
@@ -454 +457 @@
               (map car (reverse failures)))
        (if (null? failures)
-         (exit 0)
-         (exit 1)))
+         (begin (newline) (exit 0))
+         (begin (newline) (exit 1))))
       ((caar pairs)
        (loop (cdr pairs) failures))
@@ -477 +480 @@
                                         checks)))))))
  ) ; simple-tests
+

release/5/simple-tests/tags/2.0.3/tests/run.scm

@@ -73 +73 @@
   )
 
-(check-all SIMPLE (bar?) (*?) (+?) (arithmetic?) (baz?) (qux?))
+(define counter
+  (let ((n 0))
+    (lambda ()
+      (set! n (add1 n))
+      n)))
+
+(define-checks (counter? verbose?)
+  (counter) 1
+  (counter) 2
+  (counter) 3
+  (counter) 4
+  )
+
+
+(check-all SIMPLE (bar?) (*?) (+?) (arithmetic?) (baz?) (qux?)
+           (counter?))

release/5/simple-tests/trunk/simple-tests.egg

@@ -4 +4 @@
  (category testing)
  (license "BSD")
- (version "2.0.2")
+ (version "2.0.3")
  (author "Juergen Lorenz")
  (components (extension simple-tests

release/5/simple-tests/trunk/simple-tests.scm

@@ -368 +368 @@
             (args* (cddadr form))
             (pairs* (cddr form))
+            (%x (rename 'x))
             (%tests (rename 'tests))
             (%writeln (rename 'writeln))
@@ -420 +421 @@
           ,@(map (lambda (p)
                    `(,%begin
-                      (,%when ,verbose?
-                        (,%print "testing " ',(car p) " ...")
-                        ;;(,%writeln 'computed ,(car p))
-                        (,%print* "computed: ") (,%writeln ,(car p))
-                        ;;(,%writeln 'expected ,(cadr p))
-                        (,%print* "expected: ") (,%writeln ,(cadr p))
-                        )
-                      (,%set! ,%tests
-                              ;(,%cons (,%cons ,(cons %equal? p) ',(car p)) ; ok
-                              (,%cons (,%cons ((,%== ,(car p)) ,(cadr p)) ',(car p))
-                                      ,%tests))
-                      ))
+                      (,%let ((,%x ,(car p)))
+                         ; protect against functions changing state
+                        (,%when ,verbose?
+                          (,%print "testing " ',(car p) " ...")
+                          ;(,%print* "computed: ") (,%writeln ,(car p))
+                          (,%print* "computed: ") (,%writeln ,%x)
+                          (,%print* "expected: ") (,%writeln ,(cadr p))
+                          )
+                        (,%set! ,%tests
+                                ;(,%cons (,%cons ,(cons %equal? p) ',(car p)) ; ok
+                                ;(,%cons (,%cons ((,%== ,(car p)) ,(cadr p)) ',(car p))
+                                (,%cons (,%cons ((,%== ,%x) ,(cadr p)) ',(car p))
+                                        ,%tests)))
+                        ))
                  (chop pairs* 2))
           (,%let ((,%fails (,select-failures (,%reverse ,%tests))))
@@ -454 +457 @@
               (map car (reverse failures)))
        (if (null? failures)
-         (exit 0)
-         (exit 1)))
+         (begin (newline) (exit 0))
+         (begin (newline) (exit 1))))
       ((caar pairs)
        (loop (cdr pairs) failures))
@@ -477 +480 @@
                                         checks)))))))
  ) ; simple-tests
+

release/5/simple-tests/trunk/tests/run.scm

@@ -73 +73 @@
   )
 
-(check-all SIMPLE (bar?) (*?) (+?) (arithmetic?) (baz?) (qux?))
+(define counter
+  (let ((n 0))
+    (lambda ()
+      (set! n (add1 n))
+      n)))
+
+(define-checks (counter? verbose?)
+  (counter) 1
+  (counter) 2
+  (counter) 3
+  (counter) 4
+  )
+
+
+(check-all SIMPLE (bar?) (*?) (+?) (arithmetic?) (baz?) (qux?)
+           (counter?))