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

  • Participants
  • Parent commits dd12f72

Comments (0)

Files changed (3)

File 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) ...))))))
 

File 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)

File 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)