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

[nop] Improve generative tests, etc.

Browse source 
Incl.:

  - Enlarge set of generated data types
  - Use generative tests in more cases
  - Run more test rounds
This commit is contained in:
Peter Taoussanis 2023-08-16 09:44:42 +02:00
parent d5a836326a
commit 8d76d9c350
1 changed files with 77 additions and 84 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

141
test/taoensso/nippy_tests.clj
View file

@ -15,17 +15,20 @@
;;;; Config, etc. ;;;; Config, etc.
(def test-data nippy/stress-data-comparable) (def test-data nippy/stress-data-comparable)
(def tc-num-tests 120) (def tc-gen-recursive-any-equatable
(def tc-gens (tc-gens/recursive-gen tc-gens/container-type
"Like `tc-gens/any` but removes NaN (which breaks equality tests)" tc-gens/any-equatable))
(tc-gens/recursive-gen tc-gens/container-type #_simple-type
(tc-gens/one-of
[tc-gens/int tc-gens/large-integer #_tc-gens/double
(tc-gens/double* {:NaN? false})
tc-gens/char tc-gens/string tc-gens/ratio tc-gens/boolean tc-gens/keyword
tc-gens/keyword-ns tc-gens/symbol tc-gens/symbol-ns tc-gens/uuid])))
(comment (tc-gens/sample tc-gens 10)) (defmacro gen-test [num-tests [data-sym] & body]
`(let [tc-result#
(tc/quick-check ~num-tests
(tc-props/for-all [~data-sym tc-gen-recursive-any-equatable]
~@body))]
(true? (:pass? tc-result#))))
(comment
(tc-gens/sample tc-gen-recursive-any-equatable 10)
(gen-test 10 [gen-data] true))
;;;; Core ;;;; Core
@ -59,11 +62,6 @@
#(freeze % {:compressor nippy/lz4hc-compressor})) #(freeze % {:compressor nippy/lz4hc-compressor}))
test-data))) test-data)))
(is ; Try roundtrip anything that simple-check can dream up
(:result (tc/quick-check tc-num-tests
(tc-props/for-all [val tc-gens]
(= val (thaw (freeze val)))))))
(is (enc/throws? Exception (thaw (freeze test-data {:password "malformed"})))) (is (enc/throws? Exception (thaw (freeze test-data {:password "malformed"}))))
(is (enc/throws? Exception (thaw (freeze test-data {:password [:salted "p"]}) (is (enc/throws? Exception (thaw (freeze test-data {:password [:salted "p"]})
{;; Necessary to prevent against JVM segfault due to {;; Necessary to prevent against JVM segfault due to
@ -73,28 +71,34 @@
{:v1-compatibility? false ; Ref. https://goo.gl/t0OUIo {:v1-compatibility? false ; Ref. https://goo.gl/t0OUIo
:compressor nil}))) :compressor nil})))
(is ; Snappy lib compatibility (for legacy versions of Nippy) (is
(let [^bytes raw-ba (freeze test-data {:compressor nil}) (let [^bytes raw-ba (freeze test-data {:compressor nil})
^bytes xerial-ba (org.xerial.snappy.Snappy/compress raw-ba) ^bytes xerial-ba (org.xerial.snappy.Snappy/compress raw-ba)
^bytes iq80-ba (org.iq80.snappy.Snappy/compress raw-ba)] ^bytes iq80-ba (org.iq80.snappy.Snappy/compress raw-ba)]
(= (thaw raw-ba) (= (thaw raw-ba)
(thaw (org.xerial.snappy.Snappy/uncompress xerial-ba)) (thaw (org.xerial.snappy.Snappy/uncompress xerial-ba))
(thaw (org.xerial.snappy.Snappy/uncompress iq80-ba)) (thaw (org.xerial.snappy.Snappy/uncompress iq80-ba))
(thaw (org.iq80.snappy.Snappy/uncompress iq80-ba 0 (alength iq80-ba))) (thaw (org.iq80.snappy.Snappy/uncompress iq80-ba 0 (alength iq80-ba)))
(thaw (org.iq80.snappy.Snappy/uncompress xerial-ba 0 (alength xerial-ba)))))) (thaw (org.iq80.snappy.Snappy/uncompress xerial-ba 0 (alength xerial-ba)))))
"Snappy lib compatibility (for legacy versions of Nippy)")
(is ; CBC auto-encryptor compatibility (is
(= "payload" (= "payload"
(thaw (freeze "payload" {:password [:salted "pwd"] :encryptor nippy/aes128-cbc-encryptor}) (thaw (freeze "payload" {:password [:salted "pwd"] :encryptor nippy/aes128-cbc-encryptor})
(do {:password [:salted "pwd"]})))) (do {:password [:salted "pwd"]})))
"CBC auto-encryptor compatibility")
(testing "Signed long types" (testing "Signed long types"
(let [range-ushort+ (+ (long @#'nippy/range-ushort) 128) (let [range-ushort+ (+ (long @#'nippy/range-ushort) 128)
range-uint+ (+ (long @#'nippy/range-uint) 128)] range-uint+ (+ (long @#'nippy/range-uint) 128)]
[(let [r (range (- range-ushort+) range-ushort+)] (= (thaw (freeze r)) r)) [(let [r (range (long -2.5e6) (long 2.5e6))] (= (thaw (freeze r)) r))
(let [r (range (- range-ushort+) range-ushort+)] (= (thaw (freeze r)) r))
(let [n range-uint+] (= (thaw (freeze n)) n)) (let [n range-uint+] (= (thaw (freeze n)) n))
(let [n (- range-uint+)] (= (thaw (freeze n)) n))]))]) (let [n (- range-uint+)] (= (thaw (freeze n)) n))]))
(is (gen-test 1600 [gen-data] (= gen-data (thaw (freeze gen-data)))) "Generative")])
;;;; Custom types & records ;;;; Custom types & records
@ -156,12 +160,12 @@
cached (mapv nippy/cache stress) ; <=1 wrap auto-enforced cached (mapv nippy/cache stress) ; <=1 wrap auto-enforced
] ]
(is (= stress (thaw (freeze stress {:compressor nil})))) [(is (= stress (thaw (freeze stress {:compressor nil}))))
(is (= stress (thaw (freeze cached {:compressor nil})))) (is (= stress (thaw (freeze cached {:compressor nil}))))
(let [size-stress (count (freeze stress {:compressor nil})) (let [size-stress (count (freeze stress {:compressor nil}))
size-cached (count (freeze cached {:compressor nil}))] size-cached (count (freeze cached {:compressor nil}))]
(is (>= size-stress (* 3 size-cached))) (is (>= size-stress (* 3 size-cached)))
(is (< size-stress (* 4 size-cached)))))) (is (< size-stress (* 4 size-cached))))]))
(deftest _caching-metadata (deftest _caching-metadata
(let [v1 (with-meta [] {:id :v1}) (let [v1 (with-meta [] {:id :v1})
@ -174,78 +178,67 @@
(nippy/cache v1) (nippy/cache v1)
(nippy/cache v2)])] (nippy/cache v2)])]
(is (> (count frozen-without-caching) [(is (> (count frozen-without-caching)
(count frozen-with-caching))) (count frozen-with-caching)))
(is (= (thaw frozen-without-caching) (is (= (thaw frozen-without-caching)
(thaw frozen-with-caching))) (thaw frozen-with-caching)))
(is (= (mapv meta (thaw frozen-with-caching)) (is (= (mapv meta (thaw frozen-with-caching))
[{:id :v1} {:id :v2} {:id :v1} {:id :v2}])))) [{:id :v1} {:id :v2} {:id :v1} {:id :v2}]))]))
;;;; Stable binary representation of vals ;;;; Stable binary representation of vals
(deftest _stable-bin (deftest _stable-bin
[(is (= (seq (freeze test-data)) (testing "Stable binary representation of vals"
(seq (freeze test-data)))) ; f(x)=f(y) | x=y
;; As above, but try multiple times to catch possible protocol interface races: (testing "x=y !=> f(x)=f(y)"
(is (every? true? ;; `x=y => f(x)=f(y)` is unfortunately NOT true in general
(repeatedly 1000 (fn [] (= (seq (freeze test-data)) ;; Be careful to never assume the above relationship!
(seq (freeze test-data))))))) [(is (not= (vec (freeze {:a 1 :b 1})) (vec (freeze {:b 1 :a 1}))) "Small (array) map (not= (seq {:a 1 :b 1}) (seq {:b 1 :a 1}))")
(is (not= (vec (freeze [[]])) (vec (freeze ['()]))) "(= [] '()) is true")
(is (= (vec (freeze (sorted-map :a 1 :b 1)))
(vec (freeze (sorted-map :b 1 :a 1)))) "Sorted structures are immune")])
;; NB abandoning - no way to do this reliably w/o appropriate contracts from (testing "x==y => f(x)=f(y)"
;; (seq <unordered-coll>): ;; This weaker version of `x=y => f(x)=f(y)` does hold
;; [(is (= (vec (freeze test-data))
;; (is (= (seq (-> test-data freeze)) (vec (freeze test-data))))
;; (seq (-> test-data freeze thaw freeze)))) ; f(x)=f(f-1(f(x)))
;;
;; As above, but with repeated refreeze to catch possible protocol interface races:
;; (is (= (seq (freeze test-data))
;; (seq (reduce (fn [frozen _] (freeze (thaw frozen)))
;; (freeze test-data) (range 1000)))))
])
(defn qc-prop-bijection [& [n]] (is (every? true? (repeatedly 1000 (fn [] (= (vec (freeze test-data))
(let [bin->val (atom {}) (vec (freeze test-data))))))
val->bin (atom {})] "Try repeatedly to catch possible protocol interface races")
(merge
(tc/quick-check (or n 1)
(tc-props/for-all [val tc-gens]
(let [;; Nb need `seq` for Clojure hash equality:
bin (hash (seq (freeze val)))]
(and
(if (contains? val->bin val)
(= (get val->bin val) bin) ; x=y => f(x)=f(y) by clj=
(do (swap! val->bin assoc val bin)
true))
(if (contains? bin->val bin) (is (gen-test 400 [gen-data]
(= (get bin->val bin) val) ; f(x)=f(y) => x=y by clj= (= (vec (freeze gen-data))
(do (swap! bin->val assoc bin val) (vec (freeze gen-data)))) "Generative")])
true))))))
#_{:bin->val @bin->val
:val->bin @val->bin}
nil)))
(comment (testing "f(x)=f(f-1(f(x)))"
(tc-gens/sample tc-gens 10) [(is (= (vec (-> test-data freeze))
(:result (qc-prop-bijection 80)) (vec (-> test-data freeze thaw freeze))))
(let [{:keys [result bin->val val->bin]} (qc-prop-bijection 10)]
[result (vals bin->val)]))
(deftest _gc-prop-bijection (is (= (seq (freeze test-data))
(is (:result (qc-prop-bijection tc-num-tests)))) (seq (reduce (fn [frozen _] (freeze (thaw frozen)))
(freeze test-data) (range 1000))))
"Try repeatedly to catch possible protocol interface races")
(is (gen-test 400 [gen-data]
(= (vec (-> gen-data freeze))
(vec (-> gen-data freeze thaw freeze)))) "Generative")])
(testing "f(x)=f(y) => x=y"
(let [vals_ (atom {})]
(gen-test 400 [gen-data]
(let [bin (freeze gen-data)
ref (get @vals_ gen-data ::nx)]
(swap! vals_ assoc bin gen-data)
(or (= ref ::nx) (= ref bin))))))))
;;;; Thread safety ;;;; Thread safety
(deftest _thread-safe (deftest _thread-safe
[(is [(is
(let [futures (let [futures (mapv (fn [_] (future (= (thaw (freeze test-data)) test-data)))
(mapv
(fn [_]
(future
(= (thaw (freeze test-data)) test-data)))
(range 50))] (range 50))]
(every? deref futures))) (every? deref futures)))