Commits

David Krentzlin committed df59ea9

updated code to present a list that map binding names to values in the report. Renamed the tests to example so that salmonella doesn't report errors that are there on puprose

Comments (0)

Files changed (3)

test-generative.scm

   ((test-generative run-tests-with-generator) current-test-generative-iterations)
   (import chicken scheme)
 
-  (use test (only srfi-1 any reverse!) (only data-structures constantly))
+  (use test (only srfi-1 any reverse! zip) (only data-structures constantly))
 
 (define current-test-generative-iterations (make-parameter 100))
 
            (or (eq? status 'FAIL) (eq? status 'ERROR))))
        results))
 
-(define (finish/failures tests seeds iteration)
+(define (finish/failures tests seed-names seeds iteration)
   (let* ((original-handler (current-test-handler))
          (decorating-handler (lambda (status expect expr info)
                                (cond
                                  (original-handler status expect expr info))
                                 (else
                                  (original-handler status expect expr (cons `(values (iteration . ,iteration)
-                                                                                     (seeds . ,seeds))
+                                                                                     (seeds . ,(zip seed-names seeds)))
                                                                             info)))))))
     (parameterize ((current-test-handler decorating-handler))
       (apply tests seeds))))
 (define (finish/success seeds tests)
   (apply tests seeds))
 
-(define (run-tests-with-generator tests generator)
+(define (run-tests-with-generator tests seed-names generator)
   (let ((iteration-count (current-test-generative-iterations)))
     (let loop ((iteration 1) (seeds (generator)))
       (let ((results (run-iteration iteration tests seeds)))
         (if (failed-tests? results)
-            (finish/failures tests seeds iteration)
+            (finish/failures tests seed-names seeds iteration)
             (if (>= iteration iteration-count)
                 (finish/success seeds tests)
                 (loop (add1 iteration) (generator))))))))
      (run-tests-with-generator
       (lambda (?var ...)
         ?body ...)
+      (list (quote ?var) ...)
       (lambda ()
         (list (?gen) ...))))))
 

tests/examples.scm

+(use data-generators test test-generative)
+
+(test-group "group around"
+   (test-group "probably failing"
+
+       (test-generative ((number (gen-fixnum))
+                         (string (gen-string-of (gen-char #\a #\z))))
+           (test-assert "failing1" (> (string-length string) 30))
+           (test-assert ((constantly #t)))))
+
+       (test-group "all passing"
+           (test-generative ((number (gen-fixnum)))
+               (test-assert "passing1" (number? number)))))
+
+
+(test-group "other"
+            (test "foo" #t #t)
+            (test "bar" #t #t))
+
+
+(test-generative ((the-number (lambda () (random 100))))
+   (test-assert "it's numeric"  (number? the-number))
+   (test-assert "it's positive" (positive? the-number))
+   (test-assert "it's smaller that 50" (< the-number 50)))
+
+
+(test-exit)

tests/run.scm

-(use data-generators test test-generative)
-
-(test-group "group around"
-   (test-group "probably failing"
-
-       (test-generative ((number (gen-fixnum))
-                         (string (gen-string-of (gen-char #\a #\z))))
-           (test-assert "failing1" (> (string-length string) 30))
-           (test-assert ((constantly #t)))))
-
-       (test-group "all passing"
-           (test-generative ((number (gen-fixnum)))
-               (test-assert "passing1" (number? number)))))
-
-
-(test-group "other"
-            (test "foo" #t #t)
-            (test "bar" #t #t))
-
-
-(test-exit)