Commits

Anonymous committed d19abe4

implemented type verifier

Comments (0)

Files changed (3)

 (use test)
 (load "../veritas")
+(load "../veritas-verifiers")
 
 (define *protocol* (list))
 
 
 (test-group "tag")
 
-(test-group "verifiers")
+(test-group "verifiers"
+  (test-group "is"
+              (test "with values"
+                    #t
+                    (verification-success? (verify 3 is 3)))
+              (test "with predicate"
+                    #t
+                    (verification-success? (verify 3 is > 2)))
+              (test "with true"
+                    #t
+                    (verification-success? (verify #t is true)))
+              (test "with false"
+                    #t
+                    (verification-success? (verify #f is false)))))

veritas-verifiers.scm

      (is #t))
     ((_ false)
      (is #f))
-    ;; ((_ a type)
-    ;;  (have-type type))
-    ;; ((_ an type)
-    ;;  (have-type type))
+    ((_ a type)
+     (verify-type type))
+    ((_ an type)
+     (verify-type type))
     ((_ pred-or-value)
      (is-verifier pred-or-value))
     ((_ pred value more-values ...)
                   (sprintf "Expected ~S not to be ~S" value quoted-expr)
                   (sprintf "Expected ~S to be ~S" value quoted-expr))))))
 
-;; (define-syntax have-type
-;;   (lambda (form rename env)
-;;     (let* ((type (cadr form))
-;;            (type-pred (string->symbol (conc (symbol->string type) "?")))
-;;            (%make-matcher (rename 'make-matcher)))
-;;       `(,%make-matcher
-;;         (lambda (subject)
-;;           (,type-pred (force subject)))
-;;         (lambda (form subject negate)
-;;           (if negate
-;;               (sprintf "Expected ~S to not be a ~A" (force subject) (quote ,type))
-;;               (sprintf "Expected ~S to be a ~A" (force subject) (quote ,type))))))))
+(define-syntax verify-type
+  (lambda (form rename env)
+    (let* ((type (cadr form))
+           (type-pred (string->symbol (conc (symbol->string type) "?")))
+           (%type-verifier (rename 'type-verifier)))
+      `(,%type-verifier ,type-pred (quote ,type)))))
+
+(define ((type-verifier type-pred type) complement? quoted-expr expr)
+  (let* ((value (force expr))
+         (result (eval-expr complement? (type-pred value))))
+    (if result
+        (pass quoted-expr)
+        (fail quoted-expr (sprintf "Expected ~S ~A be a ~A" value (if complement? "not to" "to") type)))))
 
 (define ((close-to what #!key (delta 0.3)) actual)
   (<= (abs (- what actual)) delta))
 (define (run-verifier quoted-expr expr complement? verifier)
   (if (pending?)
       (notify-pending quoted-expr)
-      (printf "verifier is ~S~%" verifier)
       (let ((result (verifier complement? quoted-expr expr)))
         (if (verification-failure? result)
             (notify-failure result)