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

29
src/taoensso/nippy.clj
View file

@ -1199,19 +1199,22 @@
(-freeze-without-meta! (into {} x) out))) (-freeze-without-meta! (into {} x) out)))
(freezer IType (let [munge-cached (enc/fmemoize munge)]
(let [aclass (class x) (freezer IType
class-name (.getName aclass)] (let [aclass (class x)
(write-id out id-type) class-name (.getName aclass)]
(write-str out class-name) (write-id out id-type)
(let [basis-method (.getMethod aclass "getBasis" nil) (write-str out class-name)
basis (.invoke basis-method nil nil)] ;; Could cache basis generation for given class-name with generalized
(-run! ;; `-cache-proxy` or something like it, but probably not worth the extra complexity.
(fn [b] (let [basis-method (.getMethod aclass "getBasis" nil)
(let [^Field cfield (.getField aclass (name b))] basis (.invoke basis-method nil nil)]
(let [fvalue (.get cfield x)] (-run!
(-freeze-without-meta! fvalue out)))) (fn [b]
basis)))) (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 (enc/compile-if java.time.Instant
(id-freezer java.time.Instant id-time-instant (id-freezer java.time.Instant id-time-instant

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

@ -86,34 +86,52 @@
;;;; Custom types & records ;;;; Custom types & records
(deftype MyType [data]) (deftype MyType [basic_field fancy-field!]) ; Note `fancy-field!` field name will be munged
(defrecord MyRec [data]) (defrecord MyRec [basic_field fancy-field!])
(deftest _types (deftest _types
(testing "Extend to custom type" (testing "Extend to custom type"
(is (thrown? Exception ; No thaw extension yet (is
(do (alter-var-root #'nippy/*custom-readers* (constantly {})) (thrown? Exception ; No thaw extension yet
(nippy/extend-freeze MyType 1 [x s] (.writeUTF s (.data x))) (do
(thaw (freeze (MyType. "val")))))) (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))) (thaw (freeze (MyType. "basic" "fancy"))))))
(let [mt (MyType. "val")]
(= (is
(.data ^MyType mt) (do
(.data ^MyType (thaw (freeze mt)))))))) (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" (testing "Extend to custom Record"
(is (do (nippy/extend-freeze MyRec 2 [x s] (.writeUTF s (str "foo-" (:data x)))) (is
(nippy/extend-thaw 2 [s] (MyRec. (.readUTF s))) (do
(= (nippy/extend-freeze MyRec 2 [x s]
(do (MyRec. "foo-val")) (.writeUTF s (str "foo-" (:basic_field x)))
(thaw (freeze (MyRec. "val"))))))) (.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" (testing "Keyword (prefixed) extensions"
(is (is
(do (nippy/extend-freeze MyRec :nippy-tests/MyRec [x s] (.writeUTF s (:data x))) (do
(nippy/extend-thaw :nippy-tests/MyRec [s] (MyRec. (.readUTF s))) (nippy/extend-freeze MyRec :nippy-tests/MyRec [x s]
(let [mr (MyRec. "val")] (= mr (thaw (freeze mr)))))))) (.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 ;;;; Caching