评论人：reiddraper_
抱歉延误，这是我一直在用的草图
diff --git a/src/main/clojure/clojure/test/check/properties.clj b/src/main/clojure/clojure/test/check/properties.clj
index 99b5222..139ae9a 100644
--- a/src/main/clojure/clojure/test/check/properties.clj
+++ b/src/main/clojure/clojure/test/check/properties.clj
@@ -8,13 +8,47 @@
; 必须保留此声明，或任何其他声明，不得从该软件中删除。
(ns clojure.test.check.properties
+ (:import clojure.test.check.generators.Generator)
(:require [clojure.test.check.generators :as gen]))
+(defrecord Result [result pass? message stamps])
+
+(defprotocol ToResult
+ (to-result [a]))
+
+(extend java.lang.Object
+ ToResult
+ {:to-result (fn [b]
+ 看起来这里不应检查捕获的异常
+ (->Result b (not (false? b)) nil nil))})
+
+(extend nil
+ ToResult
+ {:to-result (fn [b]
+ (->Result b false nil nil))})
+
+(extend java.lang.Boolean
+ ToResult
+ {:to-result (fn [b]
+ (->Result b b nil nil))})
+
+(extend Generator
+ ToResult
+ {:to-result identity})
+
+(extend Result
+ ToResult
+ {:to-result identity})
+
+(defn message
+ [m property]
+ (assoc property :message m))
+
(defn- apply-gen
[function]
(fn [args]
- (let [result (try (apply function args) (catch Throwable t t))]
- {:result result
+ (let [result (to-result (try (apply function args) (catch Throwable t t)))]
+ {:result (:result result)
:function function
:args args})))
@@ -29,9 +63,18 @@
(for-all* [gen/int gen/int] (fn [a b] (>= (+ a b) a)))
"
[args function]
- (gen/fmap
- (apply-gen function)
- (apply gen/tuple args)))
+ (gen/bind
+ (apply gen/tuple args)
+ (fn [a]
+ (let [result ((apply-gen function) a)]
+ (cond (gen/generator? result) (gen/fmap (fn [r] (println "foo") (update-in r :args #(conj % a))) result)
+ NOTE: quick note to myself before I leave this code for the night,
+ this :else is getting hit because we're wrapping the result
+ with a {:result ...} map. Should probably do that conditionally.
+ We also need two result types I think, a result to return from
+ a property itself, and a reuslt that tacks the 'args' on top of this.
+ :else (do (println "bar") (gen/return result)))))
+ ))
(defn binding-vars
[bindings]
