Commits

certainty  committed 53bb5e3

added some tests and cleaned up code

  • Participants
  • Parent commits 436b166

Comments (0)

Files changed (2)

File tests/run.scm

 (use test)
 (load "../veritas")
 
+(define *protocol* (list))
 
+(define (jot-invokation result)
+  (set! *protocol* (cons result *protocol*)))
+
+(define-syntax with-protocol
+  (syntax-rules ()
+    ((_ code ...)
+     (parameterize ((current-success-notification-receiver jot-invokation)
+                    (current-failure-notification-receiver jot-invokation))
+       (set! *protocol* (list))
+       code ...))))
 
 (test-group "verify"
-  (verify (= 3 4)))
+  (test "invokation of success notifier" #t
+    (with-protocol
+      (verify #t)
+      (verification-success? (car *protocol*))))
+  (test "invokation of failure notifier" #t
+    (with-protocol
+      (verify #f)
+      (verification-failure? (car *protocol*)))))
 
-(test-group "falsify")
+(test-group "falsify"
+  (test "invokation of failure notifier" #t
+    (with-protocol
+      (falsify #t)
+      (verification-failure? (car *protocol*))))
+  (test "invokation of success notifier" #t
+    (with-protocol
+      (falsify #f)
+      (verification-success? (car *protocol*)))))
 
 (test-group "verify-every")
 
 
 ;; The base library assumes nothing about outputting/handling  failed or succeeded verifications.
 ;; All it does is provide a protocoll that other parts can hook into to actually do something useful with this information
-
 (define current-failure-notification-receiver (make-parameter (lambda _ #t)))
 (define current-success-notification-receiver (make-parameter (lambda _ #t)))
 
-(define (notify-failure  . args)
+(define (notify-failure . args)
   (apply (current-failure-notification-receiver) args))
 
 (define (notify-success . args)
     ((_ expr)
      (verify expr (boolean-verifier)))
     ((_ expr (verifier-name verifier-args+ ...))
-     (let ((matcher (verifier-name  verifier-args+ ...)))
+     (let ((verifier (verifier-name  verifier-args+ ...)))
        (run-verifier (quote expr) (delay expr) #f verifier)))
     ((_ expr verifier-name verifier-args+ ...)
      (verify expr (verifier-name verifier-args+ ...)))))
     ((_ expr)
      (falsify expr (boolean-verifier)))
     ((_ expr (verifier-name verifier-args+ ...))
-     (let ((matcher (verifier-name verifier-args+ ...)))
+     (let ((verifier (verifier-name verifier-args+ ...)))
        (run-verifier  (quote expr) (delay expr) #t verifier)))
     ((_ expr verifier-name verifier-args+ ...)
      (falsify expr (verifier-name verifier-args+ ...)))))
      (parameterize ((current-description description))
        e e+ ...))))
 
-;; i added that little indirection to have control on
+
+(define-record-type verification-failure
+  (fail expression message)
+  verification-failure?
+  (expression verification-failure-expression)
+  (message verification-failure-message))
+
+(define-record-type verification-success
+  (pass expression)
+  verification-success?
+  (expression verification-success-expression))
+
+;; this little indirection is here to have control over
 ;; how/if tests are run.
 ;; for example one might to run them in a sandbox
 ;; or in its own thread
 
 (define (run-verifier quoted-expr expr complement? verifier)
-  (let ((result (verifier complement? quoted-expr expr))
-        (failure-message (if complement? cadr caddr)))
-    (if (not (car result))
-        (notify-failure (failure-message result))
-        (notify-success quoted-expr))))
+  (let ((result (verifier complement? quoted-expr expr)))
+    (if (verification-failure? result)
+        (notify-failure result)
+        (notify-success result))
+    result))
+
+(define (verification-failure-message complement?)
+  (if complement? cadr caddr))
 
 ;; the verifier protocoll is simple
-;; a verifier i expected to return a procedure that receives three arguments
+;; a verifier is a procedure that returns a procedure of three arguments
 ;; 1) complement? - is that in complement context
 ;; 2) quoted-expr - the quoted-expr that shall be checked
 ;; 3) expr        - a promise fore the expression
 (define ((boolean-verifier . args) complement? quoted-expr expr)
   (let ((result (if complement? (not (force expr)) (force expr))))
     (if result
-        (list #t)
-        (list #f (if complement? (sprintf "Expected ~S not to hold" quoted-expr) (sprintf "Expected ~S to hold" quoted-expr))))))
+        (pass quoted-expr)
+        (fail quoted-expr (if complement? (sprintf "Expected ~S not to hold" quoted-expr) (sprintf "Expected ~S to hold" quoted-expr))))))