Commits

omc10  committed dfc0f13

added basic console reporter

  • Participants
  • Parent commits 57f4b0e

Comments (0)

Files changed (6)

File examples/console.scm

+(use veritas veritas-verifiers veritas-console-reporter fmt fmt-color)
+
+(verify #t is true)
+(verify-every 3 
+             (is a number)
+             (is > 0))
+
+(falsify 4 is 5)
+(pending
+  (verify 3 is 2))

File reporters/console.scm

+(module veritas-console-reporter
+  *
+  (import chicken scheme extras)
+  (use veritas fmt fmt-color posix)
+
+  (define failure-count 0)
+  (define success-count 0)
+  (define pending-count 0)
+  (define total-count   0)
+
+  (on-exit (lambda ()
+             (report-summary)
+             (_exit (if (zero? failure-count) 0 1))))
+
+  (define (update-statistics what)
+    (case what
+      ((success) (set! success-count (add1 success-count)))
+      ((failure) (set! failure-count (add1 failure-count)))
+      (else (set! pending-count (add1 pending-count))))
+    (set! total-count (add1 total-count)))
+
+  (define (report-summary)
+    (newline)
+    (fmt #t (cat
+             (fmt-bold (cat "Total: " total-count))
+             " "
+             (fmt-green (fmt-bold (cat "Passed: " success-count)))
+             " "
+             (fmt-yellow (fmt-bold (cat "Pending: " pending-count)))
+             " "
+             (fmt-red (fmt-bold (cat "Failed: " failure-count)))))
+    (newline)
+    (flush-output))
+
+  (define (report-heading) #t)
+
+  (define (report-success result)
+    (update-statistics 'success)
+    (if (current-description)
+        (fmt #t (fmt-green (cat "✔ " (current-description))))
+        (fmt #t (fmt-green (cat "✔ " (verification-success-expression result)))))
+    (newline))
+
+  (define (report-failure result)
+    (update-statistics 'failure)
+    (if (current-description)
+        (fmt #t (fmt-red (cat "✘ "  (current-description))))
+        (fmt #t (fmt-red (cat "✘ " (verification-failure-expression result)))))
+    (newline)
+    (fmt #t (cat "  " (fmt-red (verification-failure-message result))))
+    (newline))
+
+  (define (report-pending expr)
+    (update-statistics 'pending)
+    (if (current-description)
+        (fmt #t (fmt-yellow (cat "☐ " (current-description))))
+        (fmt #t (fmt-yellow (cat "☐ " expr))))
+    (newline))
+
+  (current-success-notification-receiver report-success)
+  (current-failure-notification-receiver report-failure)
+  (current-pending-notification-receiver report-pending)
+
+)

File reporters/repl.scm

 (module veritas-repl-reporter
   *
-  (import chicken scheme data-structures)
-  (use veritas fmt fmt-color)
+  (import chicken scheme data-structures csi)
+  (use veritas fmt fmt-color )
 
   (define +mode-map+
     `((plain  . ("passed" "failed"))
   (define-record-printer (verification-failure result out)
     (begin
       (fmt out (fmt-red (fmt-bold (cat (failure-designator) "  "))))
-      (fmt out (fmt-red (verification-failure-message result))))))
+      (fmt out (fmt-red (verification-failure-message result)))))
+
+  (define (verify-toplevel args)
+    (print args))
+
+  (toplevel-command 'v verify-toplevel ",v EXP\tVerify expression")
+
+
+  )

File veritas-verifiers.scm

   (let* ((value (force expr))
          (result (eval-expr complement? (apply pred value values))))
     (if result
-        (pass expr)
+        (pass quoted-expr)
         (fail quoted-expr
               (if complement?
                   (sprintf "Expected ~S not to be ~S" value quoted-expr)
      (verify expr (boolean-verifier)))
     ((_ expr (verifier-name verifier-args+ ...))
      (let ((verifier (verifier-name  verifier-args+ ...)))
-       (run-verifier (quote expr) (delay expr) #f verifier)))
+       (run-verifier (quote (verify expr (verifier-name verifier-args+ ...))) (delay expr) #f verifier)))
     ((_ expr verifier-name verifier-args+ ...)
-     (verify expr (verifier-name verifier-args+ ...)))))
+     (verify  expr (verifier-name verifier-args+ ...)))))
 
 (define-syntax verify-every
   (syntax-rules ()
     ((_ expr e e+ ...)
-     (begin
+     (list
        (verify expr e)
        (verify expr e+)...))))
 
      (falsify expr (boolean-verifier)))
     ((_ expr (verifier-name verifier-args+ ...))
      (let ((verifier (verifier-name verifier-args+ ...)))
-       (run-verifier  (quote expr) (delay expr) #t verifier)))
+       (run-verifier (quote (falsify expr (verifier-name verifier-args+ ...))) (delay expr) #t verifier)))
     ((_ expr verifier-name verifier-args+ ...)
      (falsify expr (verifier-name verifier-args+ ...)))))
 
 (define-syntax falsify-every
   (syntax-rules ()
     ((_ expr e e+ ...)
-     (begin
-       (falsify expr e)
-       (falsify expr e+) ...))))
+     (list
+      (falsify expr e)
+      (falsify expr e+) ...))))
 
 (define-syntax pending
   (syntax-rules ()

File veritas.setup

 (compile -s -d0 -O3 reporters/repl.scm -j veritas-repl-reporter -o veritas-repl-reporter.so)
 (compile -s -d0 -O3 veritas-repl-reporter.import.scm)
 
+(compile -s -d0 -O3 reporters/console.scm -j veritas-console-reporter -o veritas-console-reporter.so)
+(compile -s -d0 -O3 veritas-console-reporter.import.scm)
+
 (install-extension
   'veritas
   '("veritas.import.so" "veritas.so")
   'veritas-relp-reporter
   '("veritas-repl-reporter.import.so" "veritas-repl-reporter.so")
   `((version ,version)))
+
+(install-extension
+  'veritas-console-reporter
+  '("veritas-console-reporter.import.so" "veritas-console-reporter.so")
+  `((version ,version)))