Skip to content
Browse files

better reporting for HOC

  • Loading branch information...
1 parent 639915a commit 0ce1c4e6d19a2f9249030ab997f9ae3607c853a4 @dnaumov committed Apr 12, 2012
Showing with 12 additions and 10 deletions.
  1. +11 −10 src/contracts/core.clj
  2. +1 −0 test/contracts/test/core.clj
View
21 src/contracts/core.clj
@@ -17,15 +17,16 @@
(= (resolve (first expr)) #'=>)))
(defn gen-check [type exprs+preds]
- (->> (for [[expr pred] exprs+preds]
- (if (contract-expr? pred)
- `['~expr (~pred ~expr)]
- `['~expr (if (~pred ~expr)
- ~expr
- (throw (AssertionError.
- (report ~expr {:type ~type
- :pred '~pred
- :var ~(deref current-var)}))))]))
+ (->> (for [[expr pred] exprs+preds
+ :let [[cond ret] (if (contract-expr? pred)
+ [`(fn? ~expr) `(~pred ~expr)]
+ [`(~pred ~expr) expr])]]
+ `['~expr (if ~cond
+ ~ret
+ (throw (AssertionError.
+ (report ~expr {:type ~type
+ :pred '~pred
+ :var ~(deref current-var)}))))])
(into {})))
(defn wrap-in-list-if [pred x]
@@ -34,7 +35,7 @@
x))
(defn gen-constrained-body [f post pre args]
- (let [[pre-check-results result] (map gensym ["pre-check-results" "result"])
+ (let [[pre-check-results result] (map gensym ["pre-check-results" "result"])
[normal-args [maybe-amp :as maybe-rest]] (split-with #(not= % '&) args)
rest-args (if (= '& maybe-amp)
(next maybe-rest)
View
1 test/contracts/test/core.clj
@@ -57,6 +57,7 @@
h (apply-c (fn [f] (f 1)))]
(f inc) => "2"
(f -) => (throws AssertionError #"Post" #"pos\?")
+ (f "not a fn") => (throws AssertionError #"Pre" #"\(c/=\> number\? pos\?\)")
(g inc) => (throws AssertionError #"Pre" #"number\?")
(h inc) => (throws AssertionError #"Post" #"string\?"))))

0 comments on commit 0ce1c4e

Please sign in to comment.
Something went wrong with that request. Please try again.