Commits

David Krentzlin  committed 477c1c6

implemented basic negative expectations with (do-not)

  • Participants
  • Parent commits 88e91d1

Comments (0)

Files changed (2)

File missbehave.scm

   *current-context* context-subject-set!
   $ reset-state!
   current-spec-file
+  negative-expectation
+  do-not
 
   )
 
 ;; ============
 ;; An expectation allows us to say what we want
 ;; a procedure/object to behave like
+
+(define negative-expectation (make-parameter #f))
+
+
 (define-syntax expect
   (syntax-rules (to call)
     ((_ code to (call argument argument+ ...))
      (run-expectation
       #f
       (make-matcher check: (lambda (_) form)
-                    failure-message-generator: (lambda (_)
-                                                 (sprintf "Expected ~S to be true but was false" (quote form))))))
+                    failure-message-generator: (lambda (_ negate)
+                                                 (if negate
+                                                     (sprintf "Expected ~S not to evaluate to true but it did" (quote form))
+                                                     (sprintf "Expected ~S to be true but was false" (quote form)))))
+      (negative-expectation)))
     ((_ subject matcher)
-     (run-expectation subject matcher))))
+     (run-expectation subject matcher (negative-expectation)))))
+
+(define-syntax do-not
+  (syntax-rules ()
+    ((_ expectation)
+     (parameterize ((negative-expectation #t))
+       expectation
+       (negative-expectation #f)))))
 
 (define (format-times n)
   (if (= n 1) "once" (sprintf "~A times" n))) 
                     (and (application-count-matcher applications) (argument-matcher arguments)))
                   (lambda () (unadvise procedure))))
      
-     failure-message-generator: (lambda (_)
+     failure-message-generator: (lambda (_ negate)
                                   (receive (count-matched count-message) (application-count-matcher applications)
                                       (receive (arguments-matched argument-message) (argument-matcher arguments)
                                           (cond
 
 
 
-(define (run-expectation subject matcher)
+(define (run-expectation subject matcher #!optional (negate #f))
   (let ((check (matcher-check matcher)))
-    (unless (check subject)
-      (fail-current-example-with! (generate-failure-message matcher subject)))))
+    (cond
+     (negate
+      (when (check subject)
+        (fail-current-example-with! (generate-failure-message matcher subject #t))))
+     (else
+      (unless (check subject)
+        (fail-current-example-with! (generate-failure-message matcher subject #f)))))))
 
 
 ;; Matcher
 
 (defstruct matcher check failure-message-generator)
 
-(define (generate-failure-message matcher subject)
+(define (generate-failure-message matcher subject #!optional (negate #f))
   (let ((message-generator (matcher-failure-message-generator matcher)))
-    (message-generator subject)))
+    (message-generator subject negate)))
 
 ;; Common Matchers
 (define-syntax be
                             (if (procedure? pred-or-value)
                                 (pred-or-value subject)
                                 (equal? pred-or-value subject)))
-                   failure-message-generator: (lambda (subject)
-                                                (sprintf "Expected ~S to be ~S" subject (quote pred-or-value)))))
+                   failure-message-generator: (lambda (subject negate)
+                                                (if negate
+                                                    (sprintf "Expected ~S not to be ~S" subject (quote pred-or-value))
+                                                    (sprintf "Expected ~S to be ~S" subject (quote pred-or-value))))))
     ((_ pred value more-values ...)
      (make-matcher check: (lambda (subject)
                             (apply pred (list subject value more-values ...)))
-                   failure-message-generator: (lambda (subject)
+                   failure-message-generator: (lambda (subject negate)
                                                 (with-output-to-string
                                                   (lambda ()
-                                                    (printf "Expected ~S to be ~S" subject (quote pred))
+                                                    (if negate
+                                                        (printf "Expected ~S not to be ~S" subject (quote pred))
+                                                        (printf "Expected ~S to be ~S" subject (quote pred)))
                                                     (for-each (lambda (val)
                                                                 (printf " ~S" val))
                                                               (list value more-values ...)))))))))
            (%make-matcher (rename 'make-matcher)))
       `(,%make-matcher check: (lambda (subject)
                                 (,type-pred subject))
-                       failure-message-generator: (lambda (subject)
-                                                    (sprintf "Expected ~S to be a ~A" subject (quote ,type)))))))
+                       failure-message-generator: (lambda (subject negate)
+                                                    (if negate
+                                                        (sprintf "Expected ~S to not be a ~A" subject (quote ,type))
+                                                        (sprintf "Expected ~S to be a ~A" subject (quote ,type))))))))
 
 
 

File tests/run.scm

           (example-failed?
            (run-example
             (it "should fail"
-                (expect #f to (be true)))))))
+                (expect #f to (be true))))))
+
+    (test "Negative expectation"
+          #f
+          (example-failed?
+           (run-example
+            (it "should succeed"
+                (do-not (expect #f to (be true)))))))
+
+    (test "Negaive expectation message"
+          "Expected #t not to be #t"
+          (let* ((result (run-example
+                          (it "fail"
+                              (do-not (expect #t to (be true)))))))
+
+            (example-result-messages result))))
 
 
 (test-group "Subject"