(ns com.tailrecursion.blacktide.collections-test
"Compare native collection construction, metadata, errors and observable order."
(:require [clojure.test :refer [deftest is]]
[clojure.test.check.clojure-test :refer [defspec]]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[com.tailrecursion.blacktide :refer [loophole]]
[com.tailrecursion.blacktide.backend-fixture :as backend]))
(defn record! [events tag value] (swap! events conj tag) value)
(defmacro key-a [] :a)
(defmacro key-b [] :a)
(defn observe [form]
(binding [*ns* (the-ns 'com.tailrecursion.blacktide.collections-test)]
(eval (list 'let ['events '(atom [])
'result (list 'try [:value form]
'(catch Throwable e [:error (class e) (ex-message e)]))]
['result '(deref events)]))))
(deftest collection-values-and-constant-identity
(doseq [body ['[] '{} '#{} '[1 2 :a] '{:a 1 :b 2} '#{1 :a}
'[1 {:a [2]} #{3}] '[nil false true 1N 2M 1/2]]]
(is (= (observe body) (observe (list 'loophole [] body))) (pr-str body)))
(let [plain (fn [] [1 {:a 2}]) compiled (fn [] (loophole [] [1 {:a 2}]))
plain-meta (fn [] ^{:note :yes} [1]) compiled-meta (fn [] (loophole [] ^{:note :yes} [1]))]
(is (identical? (plain) (plain)))
(is (identical? (compiled) (compiled)))
(is (not (identical? (plain-meta) (plain-meta))))
(is (not (identical? (compiled-meta) (compiled-meta))))))
(deftest source-traversal-is-frozen
(let [entry (fn [i] [(list 'record! 'events (keyword (str "key" i)) i)
(list 'record! 'events (keyword (str "value" i)) (- i))])
map-form (into {} (map entry (range 19)))
set-form (set (map first (map entry (range 19))))]
(doseq [body [map-form set-form (vec (map second (map entry (range 19))))]]
(is (= (observe body) (observe (list 'loophole [] body)))))))
(deftest duplicate-errors-and-metadata-extent
(doseq [body [(array-map '(record! events :key1 :a) '(record! events :value1 1)
'(record! events :key2 :a) '(record! events :value2 2))
#{'(record! events :first :a) '(record! events :second :a)}]]
(let [body (with-meta body {:note '(record! events :metadata :never)})
expected (observe body) actual (observe (list 'loophole [] body))]
(is (= expected actual))
(is (= :error (ffirst actual)))
(is (not (some #{:metadata} (second actual))))))
(let [body (with-meta ['(record! events :value 1)] {:note '(record! events :metadata :done)})
compiled (list 'loophole [] body)]
(is (= (observe body) (observe compiled)))
(is (= [:value :metadata] (second (observe compiled))))
(is (= {:note :done} (meta (second (first (observe compiled)))))))
(let [quoted (list 'quote (with-meta [1] {:note '(unresolved-data)}))]
(is (= {:note '(unresolved-data)} (meta (second (first (observe (list 'loophole [] quoted)))))))))
(deftest constant-duplicates-are-compile-errors
(doseq [body [(array-map '(key-a) 1 '(key-b) 2)]
form [body (list 'loophole [] body)]]
(let [error (try (observe form) nil (catch Throwable e (backend/root-error e)))]
(is (instance? IllegalArgumentException error))))
;; Native constant sets coalesce macro-expanded duplicates. Metadata prevents
;; that constant folding, so the same duplicates then fail during construction.
(let [body #{'(key-a) '(key-b)}]
(is (= [[:value #{:a}] []] (observe body) (observe (list 'loophole [] body))))
(let [body (with-meta body {})]
(is (= (observe body) (observe (list 'loophole [] body))))
(is (= :error (ffirst (observe (list 'loophole [] body))))))))
(deftype TracedKey [id events]
Object
(hashCode [_] (swap! events conj [:hash id]) (int id))
(equals [_ other] (and (instance? TracedKey other) (= id (.-id ^TracedKey other)))))
(deftest construction-retains-key-hash-order
(doseq [body ['#{a b c} '{a 1 b 2 c 3}]]
(let [wrap (fn [body] (list 'let ['a '(TracedKey. 1 events) 'b '(TracedKey. 2 events) 'c '(TracedKey. 3 events)] body))]
(is (= (observe (wrap body)) (observe (wrap (list 'loophole [] body))))))))
(deftest construction-uses-native-operations
(let [f (fn [x] (loophole [] ^{:note :yes} [x {x x} #{x}]))
value (with-redefs [with-meta (constantly :wrong) vector (constantly :wrong)
hash-map (constantly :wrong) hash-set (constantly :wrong)] (f 3))]
(is (= [3 {3 3} #{3}] value))
(is (= {:note :yes} (meta value)))))
(deftest vector-construction-boundaries
(doseq [mode [:default :dispatcher]]
(binding [*ns* (the-ns 'com.tailrecursion.blacktide.collections-test)]
(backend/with-backend mode (fn []
(doseq [size [0 1 6 7 32 33 63] metadata [nil {} {:note :yes}]]
(let [body (with-meta (mapv #(list 'record! 'events % %) (range size)) metadata)
constant (with-meta (vec (range size)) metadata)
plain (eval (list 'fn [] constant))
compiled (eval (list 'fn [] (list 'loophole [] constant)))
observation (fn [f] [(class (f)) (meta (f))])]
(is (= [(observe body) (observation plain)]
[(observe (list 'loophole [] body)) (observation compiled)])
(pr-str [mode size metadata]))))
(doseq [size [1 6 7 32 33]
offset (distinct [0 (quot size 2) (dec size)])]
(let [body (assoc (mapv #(list 'record! 'events % %) (range size)) offset
'(throw (IllegalStateException. "stop")))]
(is (= (observe body) (observe (list 'loophole [] body))) (pr-str [mode size offset]))))
(doseq [size [1 6 7 32 33]]
(let [body (assoc (vec (range size)) 0 '(int 1000))]
(is (= (mapv class (second (first (observe body))))
(mapv class (second (first (observe (list 'loophole [] body)))))))))
(doseq [size [1 6 7 33] value [1000 1.5 (Integer/valueOf 1000)]]
(let [body (with-meta (assoc (vec (range size)) 0 value) {})
plain (eval (list 'fn [] body))
compiled (eval (list 'fn [] (list 'loophole [] body)))
observation (fn [f] [(class (first (f))) (first (f))])]
(is (= (observation plain) (observation compiled)) (pr-str [mode size value])))))))))
(def collection-form
(gen/let [items (gen/vector (gen/tuple (gen/choose 0 7) (gen/elements [:literal :event :let])) 0 24)
kind (gen/elements [:vector :map :set]) metadata? gen/boolean]
(let [values (map-indexed (fn [i [v kind]]
(let [tag (keyword (str "item" i))]
(case kind
:literal v
:event (list 'record! 'events tag v)
:let (list 'let ['x v] (list 'record! 'events tag 'x))))) items)
body (case kind :vector (vec values) :map (into {} (map vec (partition 2 values))) :set (set values))]
(if metadata? (with-meta body {:note '(record! events :metadata :ready)}) body))))
(defspec deterministic-construction-differentials {:num-tests 150 :seed 314159}
(prop/for-all [body collection-form]
(let [wrap (fn [body] (list 'let ['out body] ['out '(meta out)]))]
(= (observe (wrap body)) (observe (wrap (list 'loophole [] body)))))))