fix missing protocol methods (#367)

babashka · Jul 17, 2020 · e4b6ae4 · e4b6ae4
1 parent f28687c
commit e4b6ae4
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 14 deletions.
diff --git a/src/sci/impl/records.cljc b/src/sci/impl/records.cljc
@@ -10,20 +10,21 @@
         keys (mapv keyword fields)
         protocol-impls (utils/split-when symbol? protocol-impls)
         protocol-impls
-        (mapv (fn [[protocol-name impl]]
-                (let [protocol-var (@utils/eval-resolve-state ctx protocol-name)
-                      protocol-ns (-> protocol-var deref :ns)
-                      pns (str (vars/getName protocol-ns))
-                      fq-meth-name #(symbol pns %)
-                      args (second impl)
-                      this (first args)
-                      bindings (vec (mapcat (fn [field]
-                                              [field (list (keyword field) this)])
-                                            fields))]
-                  `(defmethod ~(fq-meth-name (str (first impl))) '~record-name ~(second impl)
-                     (let ~bindings
-                       ~@(nnext impl)))))
-              protocol-impls)]
+        (mapcat (fn [[protocol-name & impls]]
+                  (for [impl impls]
+                    (let [protocol-var (@utils/eval-resolve-state ctx protocol-name)
+                          protocol-ns (-> protocol-var deref :ns)
+                          pns (str (vars/getName protocol-ns))
+                          fq-meth-name #(symbol pns %)
+                          args (second impl)
+                          this (first args)
+                          bindings (vec (mapcat (fn [field]
+                                                  [field (list (keyword field) this)])
+                                                fields))]
+                      `(defmethod ~(fq-meth-name (str (first impl))) '~record-name ~(second impl)
+                         (let ~bindings
+                           ~@(nnext impl))))))
+                protocol-impls)]
     `(do
        ;; (prn '~record-name)
        (defn ~factory-fn-sym [& args#]

diff --git a/test/sci/records_test.cljc b/test/sci/records_test.cljc
@@ -38,6 +38,19 @@
 (extends? Area Rectangle)"]
     (is (true? (tu/eval* prog {})))))
 
+(deftest multiplefunctions-test
+  (let [prog "
+(defprotocol Area (get-area [this])
+                  (get-perimeter [this]))
+(defrecord Rectangle [width height]
+                  Area
+                  (get-area [this]
+                    (* width height))
+                  (get-perimeter [this]
+                    (+ (* 2 width) (* 2 height))))
+[(get-perimeter (Rectangle. 10 10)) (get-area (Rectangle. 10 10))]"]
+    (is (= [40 100] (tu/eval* prog {})))))
+
 (deftest instance-test
   (let [prog "
 (defrecord Rectangle [width height])