luciano/nippy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[#145] [Fix] Freezing custom types with munged field names

Browse source
This commit is contained in:
Peter Taoussanis 2022-06-27 09:51:47 +02:00
parent 941ad15b0f
commit a362398ccd
2 changed files with 53 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/taoensso/nippy.clj
View file

@ -1199,19 +1199,22 @@
(-freeze-without-meta! (into {} x) out)))
(freezer IType
(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 (name b))]
(let [^Field cfield (.getField aclass (munge-cached (name b)))]
(let [fvalue (.get cfield x)]
(-freeze-without-meta! fvalue out))))
basis))))
basis)))))
(enc/compile-if java.time.Instant
(id-freezer java.time.Instant id-time-instant

52
test/taoensso/nippy/tests/main.clj
View file

@ -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")]
(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))]
(=
(.data ^MyType mt)
(.data ^MyType (thaw (freeze mt))))))))
[(.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)))
(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-val"))
(thaw (freeze (MyRec. "val")))))))
(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