Merge pull request #1143 from frenchy64/float-generator

align :float and :double generators

Author: ikitommi

CHANGELOG.md

@@ -22,6 +22,7 @@ Malli is in well matured [alpha](README.md#alpha).
   * use `:gen/return nil` property to restore this behavior
 * Support decoding map keys into keywords for `[:map` schemas in `json-transformer` [#1135](https://github.com/metosin/malli/issues/1135)
 * FIX: `malli.registry/{mode,type}` not respected in Babashka [#1124](https://github.com/metosin/malli/issues/1124)
+* FIX: `:float` accepts doubles but never generates them [#1132](https://github.com/metosin/malli/issues/1132)
 * FIX: `:float` missing humanizer [#1122](https://github.com/metosin/malli/issues/1122)
 * Updated dependencies:
 

src/malli/generator.cljc

@@ -87,8 +87,6 @@
   (let [{:gen/keys [infinite? NaN?]} (m/properties schema)]
     {:infinite? infinite? :NaN? NaN?}))
 
-(defn- -double-gen [schema options] (gen-double (into (inf-nan schema options) (-min-max schema options))))
-
 (defn- gen-fmap [f gen] (or (-unreachable gen) (gen/fmap f gen)))
 (defn- gen-fcat [gen] (gen-fmap #(apply concat %) gen))
 (defn- gen-tuple [gens] (or (some -unreachable gens) (apply gen/tuple gens)))
@@ -363,6 +361,14 @@
     (gen/return (first es))
     (gen/elements es)))
 
+(defn- double-gen [schema options]
+  (gen/double* (merge (let [props (m/properties schema options)]
+                        {:infinite? (get props :gen/infinite? false)
+                         :NaN? (get props :gen/NaN? false)})
+                      (-> (-min-max schema options)
+                          (update :min #(some-> % double))
+                          (update :max #(some-> % double))))))
+
 (defmulti -schema-generator (fn [schema options] (m/type schema options)) :default ::default)
 
 (defmethod -schema-generator ::default [schema options] (ga/gen-for-pred (m/validator schema options)))
@@ -397,22 +403,8 @@
 (defmethod -schema-generator :nil [_ _] nil-gen)
 (defmethod -schema-generator :string [schema options] (-string-gen schema options))
 (defmethod -schema-generator :int [schema options] (gen/large-integer* (-min-max schema options)))
-(defmethod -schema-generator :double [schema options] (-double-gen schema options))
-(defmethod -schema-generator :float [schema options]
-  (let [max-float #?(:clj Float/MAX_VALUE :cljs (.-MAX_VALUE js/Number))
-        min-float (- max-float)
-        props (m/properties schema options)
-        min-max-props (-min-max schema options)
-        infinite? #?(:clj false :cljs (get props :gen/infinite? false))]
-    (->> (merge {:infinite? infinite?
-                 :NaN? (get props :gen/NaN? false)}
-                (-> min-max-props
-                    (update :min #(or (some-> % float)
-                                      #?(:clj min-float :cljs nil)))
-                    (update :max #(or (some-> % float)
-                                      #?(:clj max-float :cljs nil)))))
-         (gen/double*)
-         (gen/fmap float))))
+(defmethod -schema-generator :double [schema options] (double-gen schema options))
+(defmethod -schema-generator :float [schema options] (double-gen schema options))
 (defmethod -schema-generator :boolean [_ _] gen/boolean)
 (defmethod -schema-generator :keyword [_ _] gen/keyword)
 (defmethod -schema-generator :symbol [_ _] gen/symbol)

test/malli/generator_test.cljc

@@ -51,45 +51,27 @@
                     :qualified-symbol]]
       (is (every? (m/validator schema) (mg/sample schema {:size 1000})))))
 
-  (testing "double properties"
-    (let [infinity? #(or (= % ##Inf)
-                         (= % ##-Inf))
-          NaN? (fn [x]
-                 (#?(:clj  Double/isNaN
-                     :cljs js/isNaN)
-                  x))
-          special? #(or (NaN? %)
-                        (infinity? %))
-          test-presence (fn [f options]
-                          (some f (mg/sample [:double options]
-                                             {:size 1000})))]
-      (is (test-presence infinity? {:gen/infinite? true}))
-      (is (test-presence NaN? {:gen/NaN? true}))
-      (is (test-presence special? {:gen/infinite? true
-                                   :gen/NaN? true}))
-      (is (not (test-presence special? nil)))))
-
-  (testing "float properties"
-    (let [infinity? #(or (= % ##Inf)
-                         (= % ##-Inf))
-          NaN? (fn [x]
-                 (#?(:clj  Float/isNaN
-                     :cljs js/isNaN)
-                  x))
-          is-float? (fn [n]
-                      #?(:clj  (instance? Float n)
-                         :cljs (float? n)))
-          special? #(or (NaN? %)
-                        (infinity? %))
-          test-presence (fn [f options]
-                          (some f (mg/sample [:float options]
-                                             {:size 1000})))]
-      (is (test-presence #?(:clj (comp not infinity?) :cljs infinity?) {:gen/infinite? true}))
-      (is (test-presence is-float? {}))
-      (is (test-presence NaN? {:gen/NaN? true}))
-      (is (test-presence special? {:gen/infinite? true
-                                   :gen/NaN? true}))
-      (is (not (test-presence special? nil)))))
+  (doseq [s [:double :float]]
+    (testing (str s " properties")
+      (let [infinity? #(or (= % ##Inf)
+                           (= % ##-Inf))
+            NaN? (fn [x]
+                   (#?(:clj  Double/isNaN
+                       :cljs js/isNaN)
+                            x))
+            special? #(or (NaN? %)
+                          (infinity? %))
+            valid? (m/validator s)
+            test-presence (fn [f options]
+                            (let [vs (mg/sample [s options]
+                                                {:size 1000})]
+                              (and (every? valid? vs)
+                                   (some f vs))))]
+        (is (test-presence infinity? {:gen/infinite? true}))
+        (is (test-presence NaN? {:gen/NaN? true}))
+        (is (test-presence special? {:gen/infinite? true
+                                     :gen/NaN? true}))
+        (is (not (test-presence special? nil))))))
 
   (testing "qualified-keyword properties"
     (testing "no namespace => random"