Skip to content

Commit

Permalink
[detest] add i/diff-by, debug i/latest-concat
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Oct 8, 2024
1 parent 454c8d3 commit 55848c9
Show file tree
Hide file tree
Showing 4 changed files with 127 additions and 59 deletions.
1 change: 1 addition & 0 deletions src/contrib/debug.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@
IFn (#?(:clj invoke :cljs -invoke) [_] (dbgf [nm id 'cancelled]) (it))
(#?(:clj invoke :cljs -invoke) [_ _] it)
IDeref (#?(:clj deref :cljs -deref) [_]
(dbgf [nm id 'transferring])
(let [[t v] (try [::ok @it] (catch #?(:clj Throwable :cljs :default) e [::ex e]))]
(dbgf [nm id 'transferred (if (= ::ex t) [(type v) (ex-message v)] v)])
(if (= ::ex t) (throw v) v))))))))
Expand Down
37 changes: 28 additions & 9 deletions test/hyperfiddle/detest.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,14 +34,17 @@
#?(:cljs (defn random-seed [] (Long/fromBits (rand-int 0x100000000) (rand-int 0x100000000))))

(defprotocol Engine
(exercise [this opts flow])
(exercise [this flow])
(->rng [this])
(->opts [this])
(->dbgf [this])
(roll [this] [this nm])
(add-proc [this proc])
(del-proc [this proc]))

(defn instrument [nm flow]
(defn instrument [nm ngn flow]
(fn [step done]
(let [it ((dbg/instrument* nm flow) step done)]
(let [it ((dbg/instrument* nm (->dbgf ngn) flow) step done)]
(reify
IFn
(#?(:clj invoke :cljs -invoke) [_] (it))
Expand All @@ -53,17 +56,27 @@
([nm msg] (on-violate nm msg nil))
([nm msg e] (throw (ex-info (str nm " flow protocol violation: " msg) {} e))))

(defn debug? [ngn] (-> ngn ->opts :debug))

(defn ->engine
([] (->engine {}))
([{:keys [seed]}]
(let [seed (or seed (random-seed)), rng (->xorshift64 seed), !proc* (atom [])]
([{:keys [seed] :as o}]
(let [seed (or seed (random-seed)), rng (->xorshift64 seed), !proc* (atom [])
!n (atom 0), dbgf (case (:debug o)
(:steps) (fn [_] (swap! !n inc))
(:full) (fn [x] (swap! !n inc) (prn x))
#_else prn)]
(reify Engine
(add-proc [_ proc] (swap! !proc* conj proc))
(del-proc [_ proc] (swap! !proc* (fn [proc*] (filterv #(not= % proc) proc*))))
(roll [_] (rng))
(roll [_ n] (rng n))
(exercise [this opts flow]
(try (let [flow (fpe/enforce {:name ::root, :on-violate on-violate} flow)
(->rng [_] rng)
(->opts [_] o)
(->dbgf [_] dbgf)
(exercise [this flow]
(try (let [flow (fpe/enforce {:name 'root, :on-violate on-violate}
(cond->> flow (debug? this) (dbg/instrument* 'root dbgf)))
!s (atom nil)
root (flow #(reset! !s :step) #(reset! !s :done))]
(add-proc this root)
Expand All @@ -81,6 +94,12 @@
(when-not (str/starts-with? (ex-message e) "[DETEST OK] ")
(throw e))))))
(proc (rng)))))
(dotimes [_ 3] (root)))
(dotimes [_ (rng 10)] (root)))
(catch #?(:clj Throwable :cljs :default) e
(throw (ex-info (str "exercise failed with seed " seed) {:seed seed} e)))))))))
(throw (ex-info (str "exercise failed") {:seed seed, :steps @!n} e)))))))))

(defn minimize [ngn <s> flow]
(try (exercise ngn flow)
(catch ExceptionInfo e
(let [[n0] (<s>), n1 (-> e ex-data :steps)]
(when (or (nil? n0) (< n1 n0)) (<s> [n1 (-> e ex-data :seed)]))))))
144 changes: 94 additions & 50 deletions test/hyperfiddle/detest/incseq_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,61 +6,87 @@
[hyperfiddle.incseq.diff-impl :as d]
[hyperfiddle.incseq.perm-impl :as p]
[clojure.set :as set]
[contrib.assert :as ca]
[contrib.debug :as dbg]
[clojure.test :as t]))
[contrib.data :refer [->box]]
[clojure.test :as t]
[missionary.core :as m]
[hyperfiddle.incseq.flow-protocol-enforcer :as fpe]))

(defn %next-diff [prev-degree ngn next-fn]
(let [grow (dt/roll ngn 10), degree (+ prev-degree grow)
shrink (dt/roll ngn degree)
;; TODO if shrank ensure grown items are permuted so they stay
perm (p/rotation (dt/roll ngn degree) (dt/roll ngn degree))
(defn pick [ngn v]
(if (seq v)
(let [i (dt/roll ngn (count v))]
[(nth v i) (reduce-kv (fn [ac j x] (if (= i j) ac (conj ac x))) [] v)])
v))

(defn %next-diff [prev-size ngn next-fn]
(let [grow (dt/roll ngn 10), degree (+ prev-size grow)
shrink (dt/roll ngn prev-size), size (- degree shrink)
to-rot (vec (range (max size prev-size) degree))
stay-space (vec (range #_size (min size prev-size)))
perm-vec (loop [to-rot to-rot, stay stay-space, ret []]
(if (seq to-rot)
(let [[i stay] (pick ngn stay), [j to-rot] (pick ngn to-rot)]
(recur to-rot stay (conj ret i j)))
ret))
;; _ (prn 'perm-vec perm-vec)
perm (if (seq perm-vec) (p/recompose #{perm-vec}) {})
;; perm (p/rotation (dt/roll ngn degree) (dt/roll ngn degree))
inv (set/map-invert perm)
change (reduce (fn [m i] (assoc m (inv i i) (next-fn ngn))) {} (range prev-degree (+ prev-degree grow)))
;; _ (prn 'inv inv)
change (reduce (fn [m i] #_(prn 'i i (inv i i)) (let [i (inv i i)] (cond-> m (< i size) (assoc i (next-fn ngn)))))
{} (range prev-size (+ prev-size grow)))
;; _ (prn 'change-grown change)
change (reduce (fn [m i] (cond-> m (zero? (dt/roll ngn 2)) (assoc i (next-fn ngn))))
change (range (- degree shrink)))]
change (range size))]
{:grow grow :degree degree :shrink shrink :permutation perm :change change :freeze #{}}))

(defn %rand-incseq [ngn next-incseq-fn]
(fn [step done]
(step)
(let [!should-step? (atom false), !v (atom (d/empty-diff 0)), !done? (atom false), !cancelled? (atom false)
fin #(when-not (first (reset-vals! !done? true)) (done))
proc
(reify
IFn
(#?(:clj invoke :cljs -invoke) [_]
(let [cancelled? (first (reset-vals! !cancelled? true))]
(when (and @!should-step? (not @!done?) (not cancelled?))
(swap! !should-step? not) (step))))
(#?(:clj invoke :cljs -invoke) [this n]
(if @!done?
(dt/del-proc ngn this)
(if (> 1 (mod n 100))
(when @!should-step? (fin))
(when (and @!should-step? (not @!done?)) (swap! !should-step? not) (step)))))
IDeref
(#?(:clj deref :cljs -deref) [_]
(cond
@!done?
(throw (ex-info "transfer after done" {}))
(cond->> (fn [step done]
(step)
(let [!should-step? (atom false), !v (atom (d/empty-diff 0)), !done? (atom false), !cancelled? (atom false)
;; !dbg (atom [])
fin #(when-not (first (reset-vals! !done? true)) (done))
proc
(reify
IFn
(#?(:clj invoke :cljs -invoke) [_]
(let [cancelled? (first (reset-vals! !cancelled? true))]
(when (and @!should-step? (not @!done?) (not cancelled?))
(swap! !should-step? not) (step))))
(#?(:clj invoke :cljs -invoke) [this n]
(if @!done?
(dt/del-proc ngn this)
(if (> 1 (mod n 100))
(when @!should-step? (fin))
(when (and @!should-step? (not @!done?)) (swap! !should-step? not) (step)))))
IDeref
(#?(:clj deref :cljs -deref) [_]
(cond
@!done?
(throw (ex-info "transfer after done" {}))

@!cancelled?
(do (fin) (throw (Cancelled.)))
@!cancelled?
(do (fin) (throw (Cancelled.)))

@!should-step?
(throw (ex-info "transfer without step" {}))
@!should-step?
(throw (ex-info "transfer without step" {}))

:else
(do (swap! !should-step? not)
(if (> 1 (dt/roll ngn 100))
(do (fin) (throw (ex-info "[DETEST OK] random incseq throw" {})))
(do (condp > (dt/roll ngn 100)
1 (fin)
25 (do (swap! !should-step? not) (step))
#_else nil)
(swap! !v next-incseq-fn ngn)))))))]
(dt/add-proc ngn proc)
proc)))
:else
(do (swap! !should-step? not)
(if (> 1 (dt/roll ngn 100))
(do (fin) (throw (ex-info "[DETEST OK] random incseq throw" {})))
(do (condp > (dt/roll ngn 100)
1 (fin)
25 (do (swap! !should-step? not) (step))
#_else nil)
(swap! !v next-incseq-fn ngn)
#_(let [nx (swap! !v next-incseq-fn ngn)]
(prn 'state (swap! !dbg i/patch-vec nx))
nx)))))))]
(dt/add-proc ngn proc)
proc))
(dt/debug? ngn) (dt/instrument 'rand-incseq ngn)))

(defn next-diff [prev-diff ngn]
(%next-diff (- (:degree prev-diff) (:shrink prev-diff)) ngn dt/roll))
Expand All @@ -76,18 +102,36 @@
(dotimes [_ 100]
(let [ngn (dt/->engine)]
(t/is (nil?
(dt/exercise ngn {} (i/latest-product vector (rand-incseq ngn) (rand-incseq ngn))))))))
(dt/exercise ngn (i/latest-product vector (rand-incseq ngn) (rand-incseq ngn))))))))

(t/deftest detest-latest-concat
(dotimes [_ 500]
(let [ngn (dt/->engine)]
(t/is (nil?
(dt/exercise ngn {} (i/latest-concat (rand-lc-incseq ngn))))))))
(dt/exercise ngn (i/latest-concat (rand-lc-incseq ngn))))))))

(comment
;; how to repro and debug print
(let [ngn (dt/->engine {:seed -6858028806708848032, :debug :full})]
(dt/exercise ngn (i/latest-concat (rand-lc-incseq ngn))))
;; how to minimize when a flow test fails often
(let [<s> (->box)]
(dotimes [_ 1000]
(let [ngn (dt/->engine {:debug :steps})]
(dt/minimize ngn <s> (i/latest-concat (rand-lc-incseq ngn)))))
(<s>))
)

(t/deftest detest-fixed
(dotimes [_ 1000]
(let [ngn (dt/->engine)]
(t/is (nil?
(dt/exercise ngn {} (i/fixed (rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn)
(rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn)
(rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn))))))))
(dt/exercise ngn (i/fixed (rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn)
(rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn)
(rand-incseq ngn) (rand-incseq ngn) (rand-incseq ngn))))))))

(t/deftest detest-diff-by
(dotimes [_ 1000]
(let [ngn (dt/->engine)]
(t/is (nil?
(dt/exercise ngn (m/reductions i/patch-vec [] (rand-incseq ngn))))))))
4 changes: 4 additions & 0 deletions test/hyperfiddle/electric3_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2331,10 +2331,12 @@
(s 1 {} "hi")
% := '[join 0 spawned]
% := '[join 0 notified]
% := '[join 0 transferring]
(update % 3 dissoc :change) := '[join 0 transferred {:degree 1, :permutation {}, :grow 1, :shrink 0, :freeze #{}}]
(s 1 {} nil)
% := '[join 0 notified]
% := '[join 0 cancelled]
% := '[join 0 transferring]
% := '[join 0 terminated]
(update % 3 first) := ['join 0 'transferred Cancelled]
% := '[join 0 cancelled]
Expand All @@ -2351,10 +2353,12 @@
(s 1 {} "hi")
% := '[join 0 spawned]
% := '[join 0 notified]
% := '[join 0 transferring]
(update % 3 dissoc :change) := '[join 0 transferred {:degree 1, :permutation {}, :grow 1, :shrink 0, :freeze #{}}]
(s 1 {} nil)
% := '[join 0 notified]
% := '[join 0 cancelled]
% := '[join 0 transferring]
% := '[join 0 terminated]
(update % 3 first) := ['join 0 'transferred Cancelled]
% := '[join 0 cancelled]
Expand Down

0 comments on commit 55848c9

Please sign in to comment.