From 897c5cc276c11109bf10cd704ddc159c0b15519a Mon Sep 17 00:00:00 2001 From: Ambrose Bonnaire-Sergeant Date: Thu, 18 Apr 2024 18:47:45 -0500 Subject: [PATCH] wip --- src/com/gfredericks/test/chuck/fns.clj | 156 +++++++++++++++++++++++++ 1 file changed, 156 insertions(+) create mode 100644 src/com/gfredericks/test/chuck/fns.clj diff --git a/src/com/gfredericks/test/chuck/fns.clj b/src/com/gfredericks/test/chuck/fns.clj new file mode 100644 index 0000000..f4f1d2c --- /dev/null +++ b/src/com/gfredericks/test/chuck/fns.clj @@ -0,0 +1,156 @@ +(ns com.gfredericks.test.chuck.fns + (:require [clojure.test.check.generators :as gen] + [clojure.test.check.random :as random] + [clojure.test.check.rose-tree :as rose])) + +(defn seeded + "Creates a generator that depends on the seed parameter. + `sized-gen` is a function that takes an integer and returns + a generator. + + Examples: + + ;; generates an :int with the same seed as the outer sample. + (gen/sample (seeded (fn [seed] + (gen/tuple (gen/return seed) + (generator :int {:seed seed}))))) + => ([-9189345824394269271 0] + [2069340105756572361 -1] + [-382523443817476848 -1] + [-727106358269903677 0] + [3041036363633372983 -1] + [-3816606844531533988 1] + [-5643022030666591503 -1] + [7456223948749621027 -1] + [5327329620473603684 34] + [8284970028005224634 12])" + [seeded-gen] + (#'gen/make-gen ;;FIXME bb + (fn [^clojure.test.check.random.JavaUtilSplittableRandom rnd size] + (let [seeded-gen (seeded-gen (or (.-state rnd) + (throw (ex-info "Failed to recover seed" {:rnd rnd}))))] + (gen/call-gen seeded-gen rnd size))))) + +(defn- gen-root [options gen rnd size] + (rose/root (gen/call-gen gen rnd size))) + +(defn- -random [seed] (if seed (random/make-random seed) (random/make-random))) + +(defn sampling-eduction + "An infinite eduction of generator samples. + + :seed - set seed + :size - set size + + Second argument can be a transducer that is applied at the end of the eduction. + For 2-arity, transducer must be fn?, otherwise is treated as options. + + (sampling-eduction gen/int (take 15)) + ;=> (-1 -1 1 -1 -2 -11 0 -7 -46 122 -1 0 -1 0 0) + (sequence (take 15) (sampling-eduction gen/int {:seed 10})) + ;=> (-1 0 -1 3 1 3 -2 -2 5 0 -1 -1 -2 3 -5) + (sampling-eduction gen/int (take 15) {:seed 10}) + ;=> (-1 0 -1 3 1 3 -2 -2 5 0 -1 -1 -2 3 -5)." + ([gen] + (sampling-eduction gen identity nil)) + ([gen ?options-or-xform-fn] + (let [xform? (fn? ?options-or-xform-fn)] + (sampling-eduction gen + (if xform? ?options-or-xform-fn identity) + (when-not xform? ?options-or-xform-fn)))) + ([gen xform {:keys [seed size] :or {size 10} :as options}] + (eduction + (map-indexed (fn [iter rnd] + (let [size (mod iter size)] + (gen-root options gen rnd size)))) + (or xform identity) + (gen/lazy-random-states (-random seed))))) + +(defn- non-zero [n] + (if (zero? n) Long/MIN_VALUE n)) + +(defn- summarize-string [x] + (non-zero (reduce #(unchecked-add %1 (int %2)) 0 x))) + +(defn summarize-value [x {:keys [seed size] :as options}] + (let [n (letfn [(summarize-ident [x] + (non-zero (unchecked-add (unknown (namespace x)) + (unknown (name x))))) + (unknown [x] + (non-zero + (cond + (boolean? x) (if x -1 1) + (int? x) x + (string? x) (summarize-string x) + (ident? x) (summarize-ident x) + (coll? x) (reduce #(unchecked-add %1 (unknown %2)) 0 + (eduction + (if (and (seq? x) + (sequential? x) + (not (counted? x))) + ;; handle infinite seqs + (take 32) + identity) + x)) + (fn? x) 64 + (ifn? x) -64 + (instance? java.math.BigInteger x) (unknown (.toPlainString ^java.math.BigInteger x)) + (instance? clojure.lang.BigInt x) (unknown (str x)) + (instance? java.math.BigDecimal x) (unknown (.toPlainString ^java.math.BigDecimal x)) + (instance? Float x) (Float/floatToIntBits x) + (instance? Double x) (Double/doubleToLongBits x) + (instance? java.util.concurrent.atomic.AtomicInteger x) (.longValue ^java.util.concurrent.atomic.AtomicInteger x) + (instance? java.util.concurrent.atomic.AtomicLong x) (.longValue ^java.util.concurrent.atomic.AtomicLong x) + (instance? clojure.lang.IAtom2 x) (unchecked-add (unknown @x) 1024) + :else 456456456)))] + (unchecked-multiply + (unknown x) + (unchecked-inc size)))] + (unchecked-add n seed))) + +(defn fn-gen* [->fn-gen] + (gen/sized + (fn [size] + (seeded + (fn [seed] + (let [options {:seed seed :size size}] + (->fn-gen options))))))) + +(defn fn-gen [fn-return] + (fn-gen* + (fn [options] + (gen/return + (fn [& args] + (fn-return args options)))))) + +(defn pure-fn-gen [output] + (fn-gen + (fn [args {:keys [size seed] :as options}] + (gen/generate output size (summarize-value args options))))) + +(defn impure-fn-gen [output] + (fn-gen* + (fn [{:keys [size seed] :as options}] + (gen/return + (let [a (atom (gen/lazy-random-states (-random seed)))] + (fn [& args] + (gen-root options + (seeded + (fn [seed] + (let [options (assoc options :seed seed) + seed (summarize-value args options)] + (gen/generate output size seed)))) + (ffirst (swap-vals! a rest)) + size))))))) + +(comment + (= [#{\M} #{\M} #{\M} #{\M} #{\M} #{\M} #{\M} #{\M} #{\M} #{\M}] + (mapv (gen/generate (pure-fn-gen gen/any-printable) 3 1) + (repeat 10 45644666))) + + (= [#{} #uuid "709ca02d-8f95-4c0e-a3e0-279373fa23ef" #{} #{} [] (\{) #{} () #{} ()] + (mapv ((gen/generate (impure-fn-gen gen/any-printable) 3 1) 1) + (repeat 10 45644666))) + ((gen/generate (impure-fn-gen gen/any) 4 1) + 45644666) + )