idea: make recursive-gen interruptible

metosin · Dec 18, 2024 · 7a55609 · 7a55609
1 parent 440de1b
commit 7a55609
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 1 deletion.
diff --git a/src/malli/generator.cljc b/src/malli/generator.cljc
@@ -305,7 +305,8 @@
               dschema (m/deref schema)]
           (cond->> (generator dschema (assoc-in options [::rec-gen ref-id] scalar-ref-gen))
             (realized? scalar-ref-gen) (gen/recursive-gen
-                                        #(generator dschema (assoc-in options [::rec-gen ref-id] %))))))))
+                                        #(do #?(:clj (when (Thread/interrupted) (throw (InterruptedException.))))
+                                             (generator dschema (assoc-in options [::rec-gen ref-id] %)))))))))
 
 (defn -=>-gen [schema options]
   (let [output-generator (generator (:output (m/-function-info schema)) options)]

diff --git a/test/malli/generator_test.cljc b/test/malli/generator_test.cljc
@@ -1124,3 +1124,19 @@
   (doseq [_ (range 100)
           v (mg/sample [:seqable {:min 1} :any])]
     (is (seq v))))
+
+#?(:clj
+   (deftest interrupt-recursive-gen-test
+     (let [started (promise)
+           finished (promise)
+           f (future
+               (deliver started true)
+               (try (mg/generate [:schema {:registry {::cons [:maybe [:vector [:tuple pos-int? [:ref ::cons]]]]}}
+                                  [:vector [:ref ::cons]]]
+                                 {:seed 1
+                                  :size 10000})
+                    (catch InterruptedException _ (deliver finished :interrupted))
+                    (finally (deliver finished :not-interrupted))))]
+       @started
+       (future-cancel f)
+       (is (= :interrupted (deref finished 1000 :interrupted))))))