Commits

Anonymous committed 7290f83

added second example

Comments (0)

Files changed (2)

examples/console2.scm

+(use veritas-console veritas-quickcheck data-generators)
+
+;; general settings
+(use-documentation-formatter)
+
+;; how many examples are generated by quickcheck
+(current-sample-size 100)
+
+(group "quickcheck"
+  (define (my-reverse ls)
+    (fold cons '() ls))
+
+  (group "my-reverse"
+     (quickcheck (ls (with-size (1 . 5)
+                                (gen-list-of (cut between gen-fixnum 0 10))))
+        (let ((reversed (my-reverse ls)))
+           (verify (my-reverse reversed) (is ls) "is reversable")
+           (verify (length reversed) (is (length ls)) "preserves length")
+           (verify reversed (is (reverse ls)) "works like the builtin")))))
+
+(group "is verifier"
+  (verify "single line" (is "single line"))
+  (verify "multiline\ntext" (is "multiline\ntaxi\nstation") "handles differences in strings nicely")
+  (verify #t)
+  (verify 3 (is > 0)))
+
+(group "pending"
+  (pending "Need to fix other stuff first"
+     (verify (error "I will never be executed"))))
+
+
+(group "handling errors"
+  (verify (error "It handles errors")))

reporters/console.scm

     (report-failed-verifications))
 
   (define (report-pending-verifications)
-    (fmt #t (fmt-bold "Pending:") nl)
-    (for-each report-pending-verification pending-verifications))
+    (unless (null? pending-verifications)
+      (fmt #t (fmt-bold "Pending:") nl)
+      (for-each report-pending-verification pending-verifications)))
 
   (define (report-pending-verification result)
-    (fmt #t (space-to 4) ((colorize fmt-yellow) (extract-description result) nl)))
+    (let* ((reason (meta-data-get (verification-result-subject result) 'pending)))
+      (fmt #t (space-to 4) ((colorize fmt-yellow) (cat (extract-description result) " is pending") nl))
+      (if reason
+          (fmt #t (space-to 4) ((colorize fmt-yellow) (cat "REASON: " reason)) nl))))
 
   (define (extract-description result)
     (or (meta-data-get (verification-result-subject result) 'description)
           (verification-result-subject result)))))
 
   (define (report-failed-verifications)
-    (fmt #t (fmt-bold "Failed:") nl)
-    (for-each report-failed-verification (reverse failed-verifications)))
+    (unless (null? failed-verifications)
+      (fmt #t (fmt-bold "Failed:") nl)
+      (for-each report-failed-verification (reverse failed-verifications))))
 
   (define (report-failed-verification entry)
     (let ((id     (car entry))
 
   (define (doc/pending-formatter result)
     (let* ((reason (meta-data-get (verification-result-subject result) 'pending))
-           (reason-str (if (string? reason) (conc "[" reason "]: ") "")))
+           (reason-str (if (string? reason) (conc "[" reason "] ") "")))
       (fmt #t
            (space-to (current-column))
            ((colorize fmt-yellow) (cat (current-pending-designator) " " (extract-description result) " " reason-str nl)))))
     (when (eq? 'documentation (current-formatter))
       (cond
        ((eq? 'start state)
-        (newline)
         (fmt #t (space-to (current-column)) ((colorize fmt-bold) groupname) nl)
         (current-column (+ (current-column) 2)))
        ((eq? 'end state)
+        (newline)
         (current-column (- (current-column) 2)))
        (else #t))))