Added tests, clj only

TODO: cljs fails on maximum call stack

src/malli/core.cljc

@@ -763,16 +763,20 @@
 (defn- -ref-schema []
   ^{:type ::into-schema}
   (reify IntoSchema
-    (-into-schema [_ properties [ref :as children] options]
+    (-into-schema [_ {:keys [type] :as properties} [ref :as children] options]
       (when-not (= 1 (count children))
         (fail! ::child-error {:type :ref, :properties properties, :children children, :min 1, :max 1}))
       (let [-memoize (fn [f] (let [value (atom nil)] (fn [] (or @value) (reset! value (f)))))
             -local-ref (get-in options [::refs ref])
             -registry-ref (if-let [s (mr/-schema (registry options) ref)] (-memoize (fn [] (schema s options))))
-            -ref (cond
-                   (and -local-ref -registry-ref) (fail! ::ambiguous-ref {:type :ref, :ref ref})
-                   (not (or -local-ref -registry-ref)) (fail! ::invalid-ref {:type :ref, :ref ref, :refs (-> options ::refs keys set)})
-                   :else (or -local-ref -registry-ref))
+            -ref (or (case type
+                       :local -local-ref
+                       :registry -registry-ref
+                       nil (if (and -local-ref -registry-ref)
+                             (fail! ::ambiguous-ref {:type :ref, :ref ref})
+                             (or -local-ref -registry-ref))
+                       (fail! ::invalid-property {:type :ref, :properties properties, :key :type, :value type}))
+                     (fail! ::invalid-ref {:type :ref, :ref ref, :refs (-> options ::refs keys set)}))
             form (create-form :ref properties children)]
         ^{:type ::schema}
         (reify Schema

src/malli/error.cljc

@@ -6,8 +6,7 @@
   (-error [this] "error data structure for the Schema"))
 
 (extend-protocol SchemaError
-  #?(:clj  Object
-     :cljs default)
+  #?(:clj Object, :cljs default)
   (-error [_]))
 
 (def default-errors

src/malli/generator.cljc

@@ -91,7 +91,7 @@
 (defmethod -schema-generator :tuple [schema options] (apply gen/tuple (mapv #(generator % options) (m/children schema options))))
 #?(:clj (defmethod -schema-generator :re [schema options] (-re-gen schema options)))
 (defmethod -schema-generator :string [schema options] (-string-gen schema options))
-(defmethod -schema-generator :ref [schema {::keys [ref-max] :or {ref-max 10} :as options}]
+(defmethod -schema-generator :ref [schema {::keys [ref-max] :or {ref-max 100} :as options}]
   (let [ref (first (m/children schema options))
         ref-count (get-in options [::ref-count ref] 0)]
     (if (< ref-count ref-max)

test/malli/core_test.cljc

@@ -3,7 +3,8 @@
             [malli.core :as m]
             [malli.edn :as me]
             [malli.transform :as mt]
-            [malli.util :as mu]))
+            [malli.util :as mu]
+            [malli.registry :as mr]))
 
 (defn with-schema-forms [result]
   (some-> result
@@ -300,6 +301,7 @@
       (is (= [:string {:min 1, :max 4}] (m/form schema)))))
 
   (testing "ref schemas"
+
     (testing "local recursion"
       (let [ConsCell [:maybe {:id :cons}
                       [:tuple int? [:ref :cons]]]]
@@ -338,7 +340,53 @@
                (m/accept ConsCell m/map-syntax-visitor)))
 
         (is (= [:maybe {:id :cons}
-                [:tuple 'int? [:ref :cons]]] (m/form ConsCell))))))
+                [:tuple 'int? [:ref :cons]]] (m/form ConsCell)))))
+
+    (testing "registry-based recursion"
+      (let [registry {::ping [:maybe [:tuple [:= "ping"] [:ref ::pong]]]
+                      ::pong [:maybe [:tuple [:= "pong"] [:ref ::ping]]]}]
+
+        (is (true? (m/validate
+                     ::ping
+                     ["ping" ["pong" nil]]
+                     {:registry (mr/composite-registry (m/default-schemas) registry)})))
+
+        (is (true? (m/validate
+                     [:registry
+                      {:registry registry}
+                      ::ping]
+                     ["ping" ["pong" nil]])))))
+
+    (testing "targetted refs"
+
+      (testing "fails with"
+        (are [ref text]
+          (testing text
+            (is (thrown?
+                  #?(:clj Exception, :cljs js/Error)
+                  (m/validate
+                    [:registry
+                     {:registry {::ping [:maybe {:id ::pong} [:tuple [:= "ping"] ref]]
+                                 ::pong [:maybe {:id ::ping} [:tuple [:= "pong"] [:ref ::ping]]]}}
+                     ::ping]
+                    ["ping" ["ping" nil]]))))
+
+          [:ref ::invalid] "missing :ref"
+          [:ref ::pong] "ambiguous :ref"
+          [:ref {:type :invalid} ::pong] "invalid :ref :type"))
+
+      (testing "succeeds with"
+        (are [type value text]
+          (testing text
+            (is (m/validate
+                  [:registry
+                   {:registry {::ping [:maybe {:id ::pong} [:tuple [:= "ping"] [:ref {:type type} ::pong]]]
+                               ::pong [:maybe {:id ::ping} [:tuple [:= "pong"] [:ref {:type type} ::ping]]]}}
+                   ::ping]
+                  value)))
+
+          :local ["ping" ["ping" nil]] "local ref"
+          :registry ["ping" ["pong" nil]] "registry ref"))))
 
   (testing "re schemas"
     (doseq [form [[:re "^[a-z]+\\.[a-z]+$"]

test/malli/generator_test.cljc

@@ -28,6 +28,19 @@
     (let [schema [:string {:min 1, :max 4}]]
       (is (every? (partial m/validate schema) (mg/sample schema {:size 1000})))))
 
+  ;; TODO: fail on cljs on maximum call stack
+   #?(:clj (testing "ref"
+             (testing "local recursion"
+               (let [schema [:maybe {:id :cons}
+                             [:tuple int? [:ref :cons]]]]
+                 (is (every? (partial m/validate schema) (mg/sample schema {:size 1000})))))
+             (testing "mutual recursion"
+               (let [schema [:registry
+                             {:registry {::ping [:maybe [:tuple [:= "ping"] [:ref ::pong]]]
+                                         ::pong [:maybe [:tuple [:= "pong"] [:ref ::ping]]]}}
+                             ::ping]]
+                 (is (every? (partial m/validate schema) (mg/sample schema {:size 1000})))))))
+
   #?(:clj (testing "regex"
             (let [re #"^\d+ \d+$"]
               (m/validate re (mg/generate re)))
@@ -56,16 +69,12 @@
       (is (re-matches #"kikka_\d+" (mg/generate [:and {:gen/fmap '(partial str "kikka_")} pos-int?])))))
 
   (testing "gen/elements"
-    (dotimes [_ 1000]
-      (is (#{1 2} (mg/generate [:and {:gen/elements [1 2]} int?]))))
-    (dotimes [_ 1000]
-      (is (#{"1" "2"} (mg/generate [:and {:gen/elements [1 2], :gen/fmap 'str} int?])))))
+    (is (every? #{1 2} (mg/sample [:and {:gen/elements [1 2]} int?] {:size 1000})))
+    (is (every? #{"1" "2"} (mg/sample [:and {:gen/elements [1 2], :gen/fmap 'str} int?] {:size 1000}))))
 
   (testing "gen/gen"
-    (dotimes [_ 1000]
-      (is (#{1 2} (mg/generate [:and {:gen/gen (gen/elements [1 2])} int?]))))
-    (dotimes [_ 1000]
-      (is (#{"1" "2"} (mg/generate [:and {:gen/gen (gen/elements [1 2]) :gen/fmap str} int?]))))))
+    (is (every? #{1 2} (mg/sample [:and {:gen/gen (gen/elements [1 2])} int?] {:size 1000})))
+    (is (every? #{"1" "2"} (mg/sample [:and {:gen/gen (gen/elements [1 2]) :gen/fmap str} int?] {:size 1000})))))
 
 (deftest protocol-test
   (let [values #{1 2 3 5 8 13}
@@ -75,5 +84,4 @@
                  (-properties [_])
                  mg/Generator
                  (-generator [_ _] (gen/elements values)))]
-    (dotimes [_ 1000]
-      (is (values (mg/generate schema))))))
+    (is (every? values (mg/sample schema {:size 1000})))))