Permalink
Browse files

Fix #205: against-background in macros

  • Loading branch information...
1 parent 337b818 commit b880886eb857d595f3ee5caff785986df56ca4ad @marick committed May 9, 2013
@@ -121,7 +121,7 @@
state-wrappers
(concat state-wrappers (background-fake-wrappers fakes))))))
-(defn body-of-against-background [[_against-background_ background-forms & background-body :as form]]
+(defn body-of-against-background [[_against-background_ _background-forms_ & background-body :as form]]
`(do ~@background-body))
(defn against-background-contents-wrappers [[_against-background_ background-forms & _]]
@@ -196,41 +196,39 @@
:else
(assert-valid-code-runner! changer)))))
-
-
-
-(def against-background-forms-without-enclosed-facts (atom []))
-
-(defn note-new-nesting-level! []
- (swap! against-background-forms-without-enclosed-facts #(cons :any-old-value %)))
-(defn decrease-nesting-level! []
- (swap! against-background-forms-without-enclosed-facts rest))
-(defn note-fact! []
- (reset! against-background-forms-without-enclosed-facts []))
-
-
-(defmacro expecting-nested-facts [form & body]
- `(try
- (note-new-nesting-level!)
- (let [result# ~@body]
- (when-not (empty? @against-background-forms-without-enclosed-facts)
- (error/report-error ~form
- "Background prerequisites created by the wrapping version of"
- "`against-background` only affect nested facts. This one"
- "wraps no facts."
- ""
- "Note: if you want to supply a background to all checks in a fact, "
- "use the non-wrapping form. That is, instead of this:"
- " (fact "
- " (against-background [(f 1) => 1] "
- " (g 3 2 1) => 8 "
- " (h 1 2) => 7)) "
- "... use this:"
- " (fact "
- " (g 3 2 1) => 8 "
- " (h 1 2) => 7 "
- " (against-background (f 1) => 1)) "))
- result#)
- (finally
- (decrease-nesting-level!))))
+(def at-least-one-string-with-this-name-must-be-present [])
+
+(defn add-midje-fact-symbols [symbols]
+ (alter-var-root #'at-least-one-string-with-this-name-must-be-present
+ union
+ (set (map name symbols))))
+
+;; It would be better to check symbols like `midje/fact` than the string "fact";
+;; however, all the symbols are duplicated in midje.sweet and midje.repl (because they
+;; can be loaded independently). It seems too convoluted to list everything twice, and the
+;; worst that can happen from a name clash is that the parse error isn't caught.
+(defn assert-contains-facts! [wrapping-background-form]
+ (let [possibilities (-<> wrapping-background-form
+ body-of-against-background
+ flatten
+ (filter symbol? <>)
+ (map name <>)
+ set)]
+ (when (empty? (intersection possibilities at-least-one-string-with-this-name-must-be-present))
+ (error/report-error wrapping-background-form
+ "Background prerequisites created by the wrapping version of"
+ "`against-background` only affect nested facts. This one"
+ "wraps no facts."
+ ""
+ "Note: if you want to supply a background to all checks in a fact, "
+ "use the non-wrapping form. That is, instead of this:"
+ " (fact "
+ " (against-background [(f 1) => 1] "
+ " (g 3 2 1) => 8 "
+ " (h 1 2) => 7)) "
+ "... use this:"
+ " (fact "
+ " (g 3 2 1) => 8 "
+ " (h 1 2) => 7 "
+ " (against-background (f 1) => 1)) "))))
@@ -82,12 +82,12 @@
(defn expand-against-background [form]
(background/assert-right-shape! form)
- (background/expecting-nested-facts form
- (-<> form
- body-of-against-background
- midjcoexpand
- (wrapping/with-additional-wrappers (against-background-facts-and-checks-wrappers form) <>)
- (wrapping/multiwrap <> (against-background-contents-wrappers form)))))
+ (background/assert-contains-facts! form)
+ (-<> form
+ body-of-against-background
+ midjcoexpand
+ (wrapping/with-additional-wrappers (against-background-facts-and-checks-wrappers form) <>)
+ (wrapping/multiwrap <> (against-background-contents-wrappers form))))
(defn midjcoexpand
@@ -133,7 +133,6 @@
(defn expand-fact-body [forms metadata]
- (background/note-fact!)
(-> forms
annotate-embedded-arrows-with-line-numbers
to-semi-sweet
@@ -11,7 +11,6 @@
(defn parse [form]
(let [lineno (reader-line-number form)
[metadata _] (parse-metadata/separate-metadata form)]
- (background/note-fact!)
`(emit/future-fact (nested-facts/descriptions ~(:midje/description metadata))
(position/line-number-known ~lineno))))
View
@@ -228,3 +228,17 @@
(parse-facts/midjcoexpand `(do ~@body))))))
+(defn add-midje-fact-symbols
+ "If you use a macro to wrap Midje's fact forms, `with-state-changes` will
+ complain that it contains no facts. You can avoid that by \"registering\"
+ your macro with Midje."
+ [symbols]
+ (background/add-midje-fact-symbols symbols))
+
+(add-midje-fact-symbols '[fact facts
+ future-fact future-facts
+ pending-fact pending-facts ; Sick of the other variants
+ formula future-formula
+ ;; `check-one` appears because expansion of facts can
+ ;; happen from the bottom up.
+ check-one])
View
@@ -48,6 +48,8 @@
(silent-body 'midje.sweet/formula &form))
(defmacro silent-against-background [& _]
(silent-body 'midje.sweet/against-background &form))
+(defmacro silent-with-state-changes [& _]
+ (silent-body 'midje.sweet/with-state-changes &form))
(defmacro silent-background [& _]
(silent-body 'midje.sweet/background &form))
(defmacro silent-expect [& _]
@@ -8,7 +8,7 @@
;; This is pretty incomplete so far.
-
+ ;;; against-background
;; A macro with a let in it that surrounded a fact used to blow up.
@@ -29,3 +29,46 @@
(fact @count-of-facts-checked => 2)
+
+
+
+;; Putting a fact inside a macro should not lead to an erroneous parse error
+
+(defmacro hidden-fact [& body]
+ `(fact ~@body))
+
+(silent-with-state-changes []
+ (hidden-fact 1 => 1))
+(note-that parse-error-found)
+
+;; That can be prevented with `add-midje-fact-symbols`:
+
+(add-midje-fact-symbols '[hidden-fact])
+(with-state-changes []
+ (hidden-fact 1 => 1))
+
+;;; Here is an old bug
+
+(def db (atom 0))
+
+(defmacro with-memory-store [& body]
+ `(let [db# @db]
+ (facts
+ (with-state-changes [(before :contents (reset! db 3))
+ (after :facts (fn []))
+ (after :contents (reset! db db#))]
+ ~@body))))
+
+(with-memory-store
+ (fact 1 => 1))
+
+(defmacro with-server [& body]
+ `(let [server# (fn [])]
+ (facts
+ (with-state-changes [(after :contents (server#))]
+ ~@body))))
+
+(with-server
+ (fact 1 => 1))
+
+(with-server (with-memory-store (fact 1 => 1)))

0 comments on commit b880886

Please sign in to comment.