Merge pull request #1176 from frenchy64/issue-859-primitive-instrument

Skip instrumenting primitive fns

Author: opqdonut

docs/function-schemas.md

@@ -509,6 +509,8 @@ Turning instrumentation on:
 ; =throws=> :malli.core/invalid-output {:output [:int {:max 6}], :value 11, :args [10], :schema [:=> [:cat :int] [:int {:max 6}]]}
 ```
 
+Note that vars already containing a primitive JVM function will not be instrumented.
+
 #### Function Schema Metadata
 
 `defn` schemas can be defined with standard Var metadata. It allows `defn` schema documentation and instrumentation without dependencies to malli itself from the functions. It's just data.

src/malli/instrument.clj

@@ -8,29 +8,37 @@
 (defn -f->original [f] (-> f meta ::original (or f)))
 (defn -original [v] (let [f (deref v)] (-f->original f)))
 
-(defn -filter-ns [& ns] (fn [n _ _] ((set ns) n)))
+(defn -filter-ns [& ns] (let [ns (set ns)] (fn [n _ _] (contains? ns n))))
 (defn -filter-var [f] (fn [n s _] (f (-find-var n s))))
 (defn -filter-schema [f] (fn [_ _ {:keys [schema]}] (f schema)))
 
+(defn- -primitive-fn? [f]
+  (and (fn? f) (boolean (some (fn [^Class c] (.startsWith (.getName c) "clojure.lang.IFn$")) (supers (class f))))))
+
 (defn -strument!
   ([] (-strument! nil))
   ([{:keys [mode data filters gen report] :or {mode :instrument, data (m/function-schemas)} :as options}]
    (doall
     (for [[n d] data, [s d] d]
-      (when (or (not filters) (some #(% n s d) filters))
-        (when-let [v (-find-var n s)]
-          (case mode
-            :instrument (let [dgen (as-> (merge (select-keys options [:scope :report :gen]) d) $
-                                     (cond-> $ report (update :report (fn [r] (fn [t data] (r t (assoc data :fn-name (symbol (name n) (name s))))))))
-                                     (cond (and gen (true? (:gen d))) (assoc $ :gen gen)
-                                           (true? (:gen d)) (dissoc $ :gen)
-                                           :else $))]
-                          (alter-var-root v (fn [f]
-                                              (let [f (-f->original f)]
-                                                (-> (m/-instrument dgen f) (with-meta {::original f}))))))
-            :unstrument (alter-var-root v -f->original)
-            (mode v d))
-          v))))))
+      (when-let [v (-find-var n s)]
+        (when (and (bound? v)
+                   (or (not (-primitive-fn? @v))
+                       (println (str "WARNING: Not instrumenting primitive fn " v))))
+          (when (or (not filters) (some #(% n s d) filters))
+            (case mode
+              :instrument (let [dgen (as-> (merge (select-keys options [:scope :report :gen]) d) $
+                                       (cond-> $ report (update :report (fn [r] (fn [t data] (r t (assoc data :fn-name (symbol (name n) (name s))))))))
+                                       (cond (and gen (true? (:gen d))) (assoc $ :gen gen)
+                                             (true? (:gen d)) (dissoc $ :gen)
+                                             :else $))]
+                            (alter-var-root v (fn [f]
+                                                (when (-primitive-fn? f)
+                                                  (m/-fail! ::cannot-instrument-primitive-fn {:v v}))
+                                                (let [f (-f->original f)]
+                                                  (-> (m/-instrument dgen f) (with-meta {::original f}))))))
+              :unstrument (alter-var-root v -f->original)
+              (mode v d))
+            v)))))))
 
 (defn -schema [v]
   (let [{:keys [malli/schema arglists]} (meta v)]

src/malli/instrument.cljs

@@ -97,8 +97,8 @@
   ([{:keys [mode data filters gen report skip-instrumented?] :or {skip-instrumented? false
                                                                   mode :instrument, data (m/function-schemas :cljs)} :as options}]
    (doseq [[n d] data, [s d] d]
-     (when (or (not filters) (some #(% n s d) filters))
-       (when-let [v (-find-var n s)]
+     (when-let [v (-find-var n s)]
+       (when (or (not filters) (some #(% n s d) filters))
          (case mode
            :instrument (let [original-fn (or (-original v) v)
                              dgen (as-> (select-keys options [:scope :report :gen]) $

test/malli/instrument_test.clj

@@ -1,5 +1,6 @@
 (ns malli.instrument-test
-  (:require [clojure.test :refer [deftest is testing]]
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
             [malli.core :as m]
             [malli.instrument :as mi]))
 
@@ -8,8 +9,14 @@
 
 (defn ->plus [] plus)
 
-(defn unstrument! [] (with-out-str (mi/unstrument! {:filters [(mi/-filter-ns 'malli.instrument-test)]})))
-(defn instrument! [] (with-out-str (mi/instrument! {:filters [(mi/-filter-ns 'malli.instrument-test)]})))
+(defn primitive-DO [^double val] val)
+(m/=> primitive-DO [:=> [:cat :double] :double])
+
+(defn opts [] {:filters [(fn [& args]
+                           (and (apply (mi/-filter-ns 'malli.instrument-test) args)
+                                (apply (mi/-filter-var #(not= #'primitive-DO %)) args)))]})
+(defn unstrument! [] (with-out-str (mi/unstrument! (opts))))
+(defn instrument! [] (with-out-str (mi/instrument! (opts))))
 
 (deftest instrument!-test
 
@@ -31,6 +38,32 @@
          #":malli.core/invalid-output"
          ((->plus) 6)))))
 
+(defmacro if-bb [then & [else]]
+  (if (System/getProperty "babashka.version")
+    then
+    else))
+
+(if-bb
+  (deftest primitive-functions-can-be-instrumented
+    (is (= 42 (primitive-DO 42)))
+    (is (= "42" (primitive-DO "42")))
+    (is (mi/instrument! {:filters [(mi/-filter-var #(= #'primitive-DO %))]}))
+    (is (thrown-with-msg?
+          Exception
+          #":malli.core/invalid-input"
+          (primitive-DO "42")))
+    (is (mi/unstrument! {:filters [(mi/-filter-var #(= #'primitive-DO %))]}))
+    (is (= 42 (primitive-DO 42)))
+    (is (= "42" (primitive-DO "42"))))
+  (deftest primitive-functions-cannot-be-instrumented
+    (is (= 42.0 (primitive-DO 42)))
+    (is (thrown? ClassCastException (primitive-DO "42")))
+    (is (str/includes?
+          (with-out-str (mi/instrument! {:filters [(mi/-filter-var #(= #'primitive-DO %))]}))
+          "WARNING: Not instrumenting primitive fn #'malli.instrument-test/primitive-DO"))
+    (is (= 42.0 (primitive-DO 42)))
+    (is (thrown? ClassCastException (primitive-DO "42")))))
+
 (defn minus
   "kukka"
   {:malli/schema [:=> [:cat :int] [:int {:min 6}]]