Fix #817: mutation should be visible in protocol method (#818)

babashka · Oct 20, 2022 · cf600e6 · cf600e6
1 parent cb490f2
commit cf600e6
Show file tree

Hide file tree

Showing 4 changed files with 22 additions and 4 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,10 @@
 
 For a list of breaking changes, check [here](#breaking-changes)
 
+## Unreleased
+
+- Fix [#817](https://github.com/babashka/sci/issues/817): mutation of `deftype` field should be visible in protocol method
+
 ## v0.5.34 (2022-10-18)
 
 - Performance optimizations for `let` (up to 8x faster)

diff --git a/src/sci/impl/deftype.cljc b/src/sci/impl/deftype.cljc
@@ -48,7 +48,8 @@
   (-get-type [_]
     type)
   (-mutate [_ k v]
-    (set! ext-map (assoc ext-map k v)))
+    (set! ext-map (assoc ext-map k v))
+    v)
 
   #?@(:clj [SciPrintMethod
             (-sci-print-method [this w]

diff --git a/src/sci/impl/resolve.cljc b/src/sci/impl/resolve.cljc
@@ -143,9 +143,16 @@
                               :cljs (:mutable m))))
               v (if call? ;; resolve-symbol is already handled in the call case
                   (mark-resolve-sym k idx)
-                  (let [v (cond-> (->Node
-                                   (aget ^objects bindings idx)
-                                   nil)
+                  (let [v (cond-> (if mutable?
+                                    (let [ext-map (second (lookup ctx '__sci_this false))]
+                                      (->Node
+                                       (let [this (sci.impl.types/eval ext-map ctx bindings)
+                                             inner (sci.impl.types/getVal this)]
+                                         (get inner sym))
+                                       nil))
+                                    (->Node
+                                     (aget ^objects bindings idx)
+                                     nil))
                             #?@(:clj [tag (with-meta
                                             {:tag tag})])
                             mutable? (vary-meta assoc :mutable true))]

diff --git a/test/sci/records_test.cljc b/test/sci/records_test.cljc
@@ -189,6 +189,12 @@
       (tu/eval* (str/replace "(defprotocol IFoo (setField [_]) (getField [_])) (deftype Foo [^:volatile-mutable a] IFoo (setField [_] (set! a 10)) (getField [_] a)) (getField (doto (->Foo) (setField)))"
                              "^:volatile-mutable" #?(:clj "^:volatile-mutable"
                                                      :cljs "^:mutable")) {})))
+  (is (= [1 2 2]
+         (tu/eval* (str/replace "(defprotocol ICounter (inc! [_])) (deftype Cnt [^:volatile-mutable n] ICounter (inc! [_] (let [old-n n new-n-set (set! n (inc n)) new-n n] [old-n new-n-set new-n]))) (inc! (->Cnt 1))"
+                                "^:volatile-mutable" #?(:clj "^:volatile-mutable"
+                                                        :cljs "^:mutable"))
+                   {})))
+
   #?(:clj
      (is (re-find #"#object\[user.Foo" (sci/with-out-str (sci/eval-string "(deftype Foo []) (prn (->Foo))" {:namespaces {'clojure.core {'print-method print-method}} :classes {:allow :all}})))))
   #?(:clj