CLJS-2793: Instrumenting breaks function with varargs

Author: mfikes

src/main/cljs/cljs/spec/test/alpha.cljc

@@ -279,3 +279,17 @@ spec itself will have an ::s/failure value in ex-data:
              (map
                (fn [sym]
                  (do `(check-1 '~sym nil nil ~opts-sym)))))]))))
+
+(defmacro ^:private maybe-setup-static-dispatch [f ret arity]
+  (let [arity-accessor (symbol (str ".-cljs$core$IFn$_invoke$arity$" arity))
+        argv (mapv #(symbol (str "arg" %)) (range arity))]
+    `(when (some? (~arity-accessor ~f))
+       (set! (~arity-accessor ~ret)
+         (fn ~argv
+           (apply ~ret ~argv))))))
+
+(defmacro ^:private setup-static-dispatches [f ret max-arity]
+  `(do
+     ~@(mapv (fn [arity]
+               `(maybe-setup-static-dispatch ~f ~ret ~arity))
+         (range (inc max-arity)))))

src/main/cljs/cljs/spec/test/alpha.cljs

@@ -7,7 +7,7 @@
 ;   You must not remove this notice, or any other, from this software.
 
 (ns cljs.spec.test.alpha
-  (:require-macros [cljs.spec.test.alpha :as m :refer [with-instrument-disabled]])
+  (:require-macros [cljs.spec.test.alpha :as m :refer [with-instrument-disabled setup-static-dispatches]])
   (:require
     [goog.object :as gobj]
     [goog.userAgent.product :as product]
@@ -104,21 +104,22 @@
                          (throw (ex-info
                                   (str "Call to " v " did not conform to spec." )
                                   ed)))
-                       conformed)))]
-    (doto (fn [& args]
-            (if *instrument-enabled*
-              (with-instrument-disabled
-                (when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
-                (binding [*instrument-enabled* true]
-                  (apply f args)))
-              (apply f args)))
-      (gobj/extend (MetaFn. (fn [& args]
-                              (if *instrument-enabled*
-                                (with-instrument-disabled
-                                  (when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
-                                  (binding [*instrument-enabled* true]
-                                    (apply f args)))
-                                (apply f args))) nil)))))
+                       conformed)))
+        ret (fn [& args]
+              (if *instrument-enabled*
+                (with-instrument-disabled
+                  (when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
+                  (binding [*instrument-enabled* true]
+                    (apply f args)))
+                (apply f args)))]
+    (when-not (and (-> (meta v) :top-fn :variadic?)
+                   (zero? (-> (meta v) :top-fn :max-fixed-arity)))
+      (setup-static-dispatches f ret 20)
+      (when-some [variadic (.-cljs$core$IFn$_invoke$arity$variadic f)]
+        (set! (.-cljs$core$IFn$_invoke$arity$variadic ret)
+          (fn [& args]
+            (apply variadic args)))))
+    ret))
 
 (defn- no-fspec
   [v spec]

src/test/cljs/cljs/spec_test.cljs

@@ -368,6 +368,51 @@
   :args (s/cat :k keyword?)
   :ret  string?)
 
+(defn foo-2793 [m & args]
+  {:m m, :args args})
+
+(defn bar-2793
+  ([x] {:x x})
+  ([x y] {:x x, :y y})
+  ([x y & m] {:x x, :y y, :m m}))
+
+(defn baz-2793 [x & ys])
+
+(defn quux-2793 [& numbers])
+
+(s/fdef foo-2793)
+(s/fdef bar-2793)
+(s/fdef baz-2793 :args (s/cat :x number? :ys (s/* number?)))
+
+(st/instrument `foo-2793)
+(st/instrument `bar-2793)
+(st/instrument `baz-2793)
+
+(deftest cljs-2793-test
+  (is (= {:m {:x 1 :y 2}
+          :args nil}
+        (foo-2793 {:x 1 :y 2})))
+  (is (= {:m {:x 1 :y 2}
+          :args [1]}
+        (foo-2793 {:x 1 :y 2} 1)))
+  (is (= {:m {:x 1 :y 2}
+          :args [1 2]}
+        (foo-2793 {:x 1 :y 2} 1 2)))
+  (is (= {:x 1}
+        (bar-2793 1)))
+  (is (= {:x 1
+          :y 2}
+        (bar-2793 1 2)))
+  (is (= {:x 1
+          :y 2
+          :m [3]}
+        (bar-2793 1 2 3)))
+  (is (= {:x 1
+          :y 2
+          :m [3 4]}
+        (bar-2793 1 2 3 4)))
+  (is (nil? (baz-2793 1))))
+
 (comment
 
   (run-tests)