CLJS-2085: defrecord recur method head target object

Author: mfikes

src/main/clojure/cljs/analyzer.cljc

@@ -137,6 +137,7 @@
    :protocol-duped-method true
    :protocol-multiple-impls true
    :protocol-with-variadic-method true
+   :protocol-impl-recur-with-target true
    :single-segment-namespace true
    :munged-namespace true
    :ns-var-clash true
@@ -358,6 +359,10 @@
   (str "Protocol " (:protocol info) " declares method "
        (:name info) " with variadic signature (&)"))
 
+(defmethod error-message :protocol-impl-recur-with-target
+  [warning-type info]
+  (str "Ignoring target object \"" (:form info) "\" passed in recur to protocol method head"))
+
 (defmethod error-message :multiple-variadic-overloads
   [warning-type info]
   (str (:name info) ": Can't have more than 1 variadic overload"))
@@ -1471,7 +1476,9 @@
                           (butlast params)
                           params)
         fixed-arity     (count params')
-        recur-frame     {:params params :flag (atom nil)}
+        recur-frame     {:protocol-impl (:protocol-impl env)
+                         :params        params
+                         :flag          (atom nil)}
         recur-frames    (cons recur-frame *recur-frames*)
         body-env        (assoc env :context :return :locals locals)
         body-form       `(do ~@body)
@@ -1758,11 +1765,18 @@
   [op env [_ & exprs :as form] _ _]
   (let [context (:context env)
         frame (first *recur-frames*)
+        ;; Add dummy implicit target object if recuring to proto impl method head
+        add-implicit-target-object? (and (:protocol-impl frame)
+                                         (= (count exprs) (dec (count (:params frame)))))
+        exprs (cond->> exprs add-implicit-target-object? (cons nil))
         exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs)))]
     (when-not frame
       (throw (error env "Can't recur here")))
     (when-not (= (count exprs) (count (:params frame)))
       (throw (error env "recur argument count mismatch")))
+    (when (and (:protocol-impl frame)
+               (not add-implicit-target-object?))
+      (warning :protocol-impl-recur-with-target env {:form (:form (first exprs))}))
     (reset! (:flag frame) true)
     (assoc {:env env :op :recur :form form}
       :frame frame

src/test/cljs/cljs/recur_test.cljs

@@ -0,0 +1,64 @@
+;; Copyright (c) Rich Hickey. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns cljs.recur-test
+  (:require [cljs.test :refer-macros [deftest is]]))
+
+;; Setup for CLJS-2085
+
+(defprotocol ISearch
+  (search [this coll]))
+
+;; Passing this in the recur call here will cause a warning to be emitted
+(defrecord Search1 [needle]
+  ISearch
+  (search [this coll]
+    (when (seq coll)
+      (if (= needle (first coll))
+        needle
+        (recur this (rest coll))))))
+
+;; This code will be accepted as is
+(defrecord Search2 [needle]
+  ISearch
+  (search [_ coll]
+    (when (seq coll)
+      (if (= needle (first coll))
+        needle
+        (recur (rest coll))))))
+
+;; This code will also be accepted as is; the recur is to a loop
+(defrecord Search3 [needle]
+  ISearch
+  (search [this coll]
+    (loop [coll coll]
+      (when (seq coll)
+        (if (= needle (first coll))
+          needle
+          (recur (rest coll)))))))
+
+;; This code should not cause a warning to be emitted
+(defrecord Search4 [needle]
+  ISearch
+  (search [this coll]
+    (let [search-fn (fn [coll]
+                      (when (seq coll)
+                        (if (= needle (first coll))
+                          needle
+                          (recur (rest coll)))))]
+      (search-fn coll))))
+
+(deftest cljs-2085-test
+  (is (= 1 (-> (->Search1 1) (search [:a 1 "b"]))))
+  (is (nil? (-> (->Search1 :z) (search [:a 1 "b"]))))
+  (is (= 1 (-> (->Search2 1) (search [:a 1 "b"]))))
+  (is (nil? (-> (->Search2 :z) (search [:a 1 "b"]))))
+  (is (= 1 (-> (->Search3 1) (search [:a 1 "b"]))))
+  (is (nil? (-> (->Search3 :z) (search [:a 1 "b"]))))
+  (is (= 1 (-> (->Search4 1) (search [:a 1 "b"]))))
+  (is (nil? (-> (->Search4 :z) (search [:a 1 "b"])))))

src/test/cljs/test_runner.cljs

@@ -41,7 +41,8 @@
             [cljs.predicates-test]
             [cljs.tagged-literals-test]
             [cljs.test-test]
-            [static.core-test]))
+            [static.core-test]
+            [cljs.recur-test]))
 
 (set! *print-newline* false)
 (set-print-fn! js/print)
@@ -80,4 +81,5 @@
   'cljs.syntax-quote-test
   'cljs.tagged-literals-test
   'cljs.test-test
-  'static.core-test)
+  'static.core-test
+  'cljs.recur-test)

src/test/self/self_parity/test.cljs

@@ -296,7 +296,8 @@
                    [cljs.syntax-quote-test]
                    [cljs.predicates-test]
                    [cljs.test-test]
-                   [static.core-test]))
+                   [static.core-test]
+                   [cljs.recur-test]))
       (fn [{:keys [value error]}]
         (if error
           (handle-error error (:source-maps @st))
@@ -334,7 +335,8 @@
                'cljs.syntax-quote-test
                'cljs.predicates-test
                'cljs.test-test
-               'static.core-test)
+               'static.core-test
+               'cljs.recur-test)
             (fn [{:keys [value error]}]
               (when error
                 (handle-error error (:source-maps @st))))))))))