From a362398ccdfb9463f6c5e313f7ee42d831654f90 Mon Sep 17 00:00:00 2001
From: Peter Taoussanis <peter@taoensso.com>
Date: Mon, 27 Jun 2022 09:51:47 +0200
Subject: [PATCH] [#145] [Fix] Freezing custom types with munged field names

---
 src/taoensso/nippy.clj             | 29 +++++++++-------
 test/taoensso/nippy/tests/main.clj | 56 ++++++++++++++++++++----------
 2 files changed, 53 insertions(+), 32 deletions(-)

diff --git a/src/taoensso/nippy.clj b/src/taoensso/nippy.clj
index 5711b2f..cd4cec1 100644
--- a/src/taoensso/nippy.clj
+++ b/src/taoensso/nippy.clj
@@ -1199,19 +1199,22 @@
 
     (-freeze-without-meta! (into {} x) out)))
 
-(freezer IType
-   (let [aclass     (class x)
-         class-name (.getName aclass)]
-     (write-id  out id-type)
-     (write-str out class-name)
-     (let [basis-method (.getMethod aclass "getBasis" nil)
-           basis        (.invoke basis-method nil nil)]
-       (-run!
-         (fn [b]
-           (let [^Field cfield (.getField aclass (name b))]
-             (let [fvalue (.get cfield x)]
-               (-freeze-without-meta! fvalue out))))
-         basis))))
+(let [munge-cached (enc/fmemoize munge)]
+  (freezer IType
+    (let [aclass     (class x)
+          class-name (.getName aclass)]
+      (write-id  out id-type)
+      (write-str out class-name)
+      ;; Could cache basis generation for given class-name with generalized
+      ;; `-cache-proxy` or something like it, but probably not worth the extra complexity.
+      (let [basis-method (.getMethod aclass "getBasis" nil)
+            basis        (.invoke basis-method nil nil)]
+        (-run!
+          (fn [b]
+            (let [^Field cfield (.getField aclass (munge-cached (name b)))]
+              (let [fvalue (.get cfield x)]
+                (-freeze-without-meta! fvalue out))))
+          basis)))))
 
 (enc/compile-if java.time.Instant
   (id-freezer java.time.Instant id-time-instant
diff --git a/test/taoensso/nippy/tests/main.clj b/test/taoensso/nippy/tests/main.clj
index 656b27b..99eb252 100644
--- a/test/taoensso/nippy/tests/main.clj
+++ b/test/taoensso/nippy/tests/main.clj
@@ -86,34 +86,52 @@
 
 ;;;; Custom types & records
 
-(deftype   MyType [data])
-(defrecord MyRec  [data])
+(deftype   MyType [basic_field fancy-field!]) ; Note `fancy-field!` field name will be munged
+(defrecord MyRec  [basic_field fancy-field!])
 
 (deftest _types
   (testing "Extend to custom type"
-    (is (thrown? Exception ; No thaw extension yet
-          (do (alter-var-root #'nippy/*custom-readers* (constantly {}))
-              (nippy/extend-freeze MyType 1 [x s] (.writeUTF s (.data x)))
-              (thaw (freeze (MyType. "val"))))))
+    (is
+      (thrown? Exception ; No thaw extension yet
+        (do
+          (alter-var-root #'nippy/*custom-readers* (constantly {}))
+          (nippy/extend-freeze MyType 1 [x s]
+            (.writeUTF s (.basic_field  x))
+            (.writeUTF s (.fancy-field! x)))
 
-    (is (do (nippy/extend-thaw 1 [s] (MyType. (.readUTF s)))
-            (let [mt (MyType. "val")]
-              (=
-                (.data ^MyType               mt)
-                (.data ^MyType (thaw (freeze mt))))))))
+          (thaw (freeze (MyType. "basic" "fancy"))))))
+
+    (is
+      (do
+        (nippy/extend-thaw 1 [s] (MyType. (.readUTF s) (.readUTF s)))
+        (let [mt1 (MyType. "basic" "fancy")
+              ^MyType mt2 (thaw (freeze mt1))]
+          (=
+            [(.basic_field mt1) (.fancy-field! mt1)]
+            [(.basic_field mt2) (.fancy-field! mt2)])))))
 
   (testing "Extend to custom Record"
-    (is (do (nippy/extend-freeze MyRec 2 [x s] (.writeUTF s (str "foo-" (:data x))))
-            (nippy/extend-thaw 2 [s] (MyRec. (.readUTF s)))
-            (=
-              (do           (MyRec. "foo-val"))
-              (thaw (freeze (MyRec. "val")))))))
+    (is
+      (do
+        (nippy/extend-freeze MyRec 2 [x s]
+          (.writeUTF s (str "foo-" (:basic_field  x)))
+          (.writeUTF s (str "foo-" (:fancy-field! x))))
+
+        (nippy/extend-thaw 2 [s] (MyRec. (.readUTF s) (.readUTF s)))
+        (=
+          (do           (MyRec. "foo-basic" "foo-fancy"))
+          (thaw (freeze (MyRec.     "basic"     "fancy")))))))
 
   (testing "Keyword (prefixed) extensions"
     (is
-      (do (nippy/extend-freeze MyRec :nippy-tests/MyRec [x s] (.writeUTF s (:data x)))
-          (nippy/extend-thaw :nippy-tests/MyRec [s] (MyRec. (.readUTF s)))
-          (let [mr (MyRec. "val")] (= mr (thaw (freeze mr))))))))
+      (do
+        (nippy/extend-freeze MyRec :nippy-tests/MyRec [x s]
+          (.writeUTF s (:basic_field  x))
+          (.writeUTF s (:fancy-field! x)))
+
+        (nippy/extend-thaw :nippy-tests/MyRec [s] (MyRec. (.readUTF s) (.readUTF s)))
+        (let [mr (MyRec. "basic" "fancy")]
+          (=  mr (thaw (freeze mr))))))))
 
 ;;;; Caching