greg/mentat
1
0
Fork 0
Code Issues 294 Pull requests Projects Releases 9 Packages Wiki Activity

Unify test pattern around "(... -after tx0)".

Browse source
This commit is contained in:
Nick Alexander 2016-08-03 15:41:40 -07:00
parent 296c9cb436
commit 13f33a4915
1 changed files with 132 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
test/datomish/db_test.cljc
View file

@ -40,7 +40,7 @@
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair (go-pair
(->> (->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx >= ?" tx]) (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
(<?) (<?)
(mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %))) (mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %)))
(filter #(not (= :db/txInstant (second %)))) (filter #(not (= :db/txInstant (second %))))
@ -62,7 +62,7 @@
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair (go-pair
(->> (->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx >= ? ORDER BY tx ASC, e, a, v, added" tx]) (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx > ? ORDER BY tx ASC, e, a, v, added" tx])
(<?) (<?)
(mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %))))))) (mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
@ -117,16 +117,15 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef] now 0xdeadbeef]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now))))) (let [tx0 (tx (<? (dm/<transact! conn test-schema now)))]
(let [;; TODO: drop now, allow to set :db/txInstant. (let [;; TODO: drop now, allow to set :db/txInstant.
report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now)) report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now))
tx (tx report)] tx (tx report)]
(is (= (<? (<datoms-after (dm/db conn) tx)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[0 :name "valuex"]})) #{[0 :name "valuex"]}))
(is (= (<? (<transactions-after (dm/db conn) tx)) (is (= (<? (<transactions-after (dm/db conn) tx0))
[[0 :name "valuex" tx 1] ;; TODO: true, not 1. [[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant now tx 1]]))) [tx :db/txInstant now tx 1]]))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -137,18 +136,17 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef] now 0xdeadbeef]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now))))) (let [tx0 (tx (<? (dm/<transact! conn test-schema now)))
tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now)))
(let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now)))
tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now))) tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now)))
tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now))) tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now)))
tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] now)))] tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] now)))]
(is (= (<? (<datoms-after (dm/db conn) tx1)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[1 :name "Petr"] #{[1 :name "Petr"]
[1 :aka "Tupen"] [1 :aka "Tupen"]
[1 :aka "Devil"]})) [1 :aka "Devil"]}))
(is (= (<? (<transactions-after (dm/db conn) tx1)) (is (= (<? (<transactions-after (dm/db conn) tx0))
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1. [[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
[tx1 :db/txInstant now tx1 1] [tx1 :db/txInstant now tx1 1]
[1 :name "Ivan" tx2 0] [1 :name "Ivan" tx2 0]
@ -158,6 +156,7 @@
[tx3 :db/txInstant now tx3 1] [tx3 :db/txInstant now tx3 1]
[1 :aka "Devil" tx4 1] [1 :aka "Devil" tx4 1]
[tx4 :db/txInstant now tx4 1]]))) [tx4 :db/txInstant now tx4 1]])))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -169,13 +168,12 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef] now 0xdeadbeef]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now))))) (let [tx0 (tx (<? (dm/<transact! conn test-schema now)))
txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now)))
(let [txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now)))
txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x 123]] now)))] txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x 123]] now)))]
(is (= (<? (<datoms-after (dm/db conn) txa)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{})) #{}))
(is (= (<? (<transactions-after (dm/db conn) txa)) (is (= (<? (<transactions-after (dm/db conn) tx0))
[[0 :x 123 txa 1] ;; TODO: true, not 1. [[0 :x 123 txa 1] ;; TODO: true, not 1.
[txa :db/txInstant now txa 1] [txa :db/txInstant now txa 1]
[0 :x 123 txb 0] [0 :x 123 txb 0]
@ -190,9 +188,8 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now -1] now -1]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now))))) (let [tx0 (tx (<? (dm/<transact! conn test-schema now)))
report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :x 0]
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :x 0]
[:db/add (dm/id-literal :db.part/user -1) :y 1] [:db/add (dm/id-literal :db.part/user -1) :y 1]
[:db/add (dm/id-literal :db.part/user -2) :y 2] [:db/add (dm/id-literal :db.part/user -2) :y 2]
[:db/add (dm/id-literal :db.part/user -2) :y 3]] now))] [:db/add (dm/id-literal :db.part/user -2) :y 3]] now))]
@ -200,10 +197,9 @@
[(dm/id-literal :db.part/user -1) [(dm/id-literal :db.part/user -1)
(dm/id-literal :db.part/user -2)])) (dm/id-literal :db.part/user -2)]))
(let [tx (get-in report [:db-after :current-tx]) (let [eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)])
eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (dm/id-literal :db.part/user -2)])] eid2 (get-in report [:tempids (dm/id-literal :db.part/user -2)])]
(is (= (<? (<datoms-after (dm/db conn) tx)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid1 :x 0] #{[eid1 :x 0]
[eid1 :y 1] [eid1 :y 1]
[eid2 :y 2] [eid2 :y 2]
@ -219,8 +215,7 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now -1] now -1]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now))))) (let [tx0 (tx (<? (dm/<transact! conn test-schema now)))]
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid" (testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"unique constraint" ExceptionInfo #"unique constraint"
@ -231,7 +226,7 @@
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"unique constraint" ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :spouse "Dana"] (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :spouse "Dana"]
[:db/add (dm/id-literal :db.part/user -2) :spouse "Dana"]] now))))) [:db/add (dm/id-literal :db.part/user -2) :spouse "Dana"]] now))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -243,32 +238,31 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now -1] now -1]
(try (try
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) (let [tx0 (tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1)
:db/ident :test/kw :db/ident :test/kw
:db/unique :db.unique/identity :db/unique :db.unique/identity
:db/valueType :db.type/keyword} :db/valueType :db.type/keyword}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/user -1)}] now)) {:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/user -1)}] now)))]
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now)) (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now))
tx (get-in report [:db-after :current-tx])
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])] eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
(is (= (<? (<datoms-after (dm/db conn) tx)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw. #{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(testing "Adding the same value compares existing values correctly." (testing "Adding the same value compares existing values correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]] now)) (<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]] now))
(is (= (<? (<datoms-after (dm/db conn) tx)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw. #{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(testing "Upserting retracts existing value correctly." (testing "Upserting retracts existing value correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]] now)) (<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]] now))
(is (= (<? (<datoms-after (dm/db conn) tx)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw. #{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(testing "Retracting compares values correctly." (testing "Retracting compares values correctly."
(<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now)) (<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now))
(is (= (<? (<datoms-after (dm/db conn) tx)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{})))) #{})))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -281,13 +275,11 @@
now 0xdeadbeef now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))] tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store. ;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now)) (<? (dm/<transact! conn test-schema now))
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)) {:db/id 102 :name "Petr" :email "@2"}] now)))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
@ -310,7 +302,7 @@
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 35] [:db/add (dm/id-literal :db.part/user -1) :age 35]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"] [:db/add (dm/id-literal :db.part/user -1) :name "Petr"]
[:db/add (dm/id-literal :db.part/user -1) :age 36]] now))))) [:db/add (dm/id-literal :db.part/user -1) :age 36]] now))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -325,8 +317,8 @@
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store. ;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now)) (<? (dm/<transact! conn test-schema now))
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)) {:db/id 102 :name "Petr" :email "@2"}] now)))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}] now))] (let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}] now))]
@ -364,7 +356,7 @@
(testing "upsert to two entities, two tempids, fails due to overlapping writes" (testing "upsert to two entities, two tempids, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint" (is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}] now))))) {:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}] now))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -380,8 +372,8 @@
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; fail until the final one, so we never need to reset the underlying store. ;; fail until the final one, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now)) (<? (dm/<transact! conn test-schema now))
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)) {:db/id 102 :name "Petr" :email "@2"}] now)))]
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with existing id" (testing "upsert conficts with existing id"
@ -403,7 +395,7 @@
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@3" :age 35})) {:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report) (is (= (tempids report)
{-1 101})))) {-1 101})))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))