|
47 | 47 | (let [schema {:aka {:db/cardinality :db.cardinality/many}} |
48 | 48 | db (ds/empty-db schema)] |
49 | 49 | (t/is (= schema (ds/schema db))))) |
| 50 | + |
| 51 | +(deftest ^{:doc "Transient indices might lead to data corruption. |
| 52 | + Transacting against a db must not corrupt older db values: |
| 53 | + transient conj!/disj! during transact used to mutate index |
| 54 | + tree nodes shared with the persistent base db"} |
| 55 | + issue-373 |
| 56 | + (let [schema {:vs {:db/cardinality :db.cardinality/many}} |
| 57 | + evens (range 0 8192 2) |
| 58 | + db0 (ds/db-with (ds/empty-db schema) |
| 59 | + [{:db/id 1 :vs (vec evens)}]) |
| 60 | + _ (ds/db-with db0 |
| 61 | + (concat |
| 62 | + ;; inserts in the middle of shared index trees |
| 63 | + (for [v (range 1 2048 2)] |
| 64 | + [:db/add 1 :vs v]) |
| 65 | + ;; removals of datoms belonging to db0 |
| 66 | + (for [v (range 0 2048 2)] |
| 67 | + [:db/retract 1 :vs v]) |
| 68 | + (for [v (range 4096 6144)] |
| 69 | + [:db/add 1 :vs v])))] |
| 70 | + ;; db0 must stay intact: iteration order... |
| 71 | + (t/is (= evens (map :v (ds/datoms db0 :eavt)))) |
| 72 | + (t/is (= evens (map :v (ds/datoms db0 :aevt)))) |
| 73 | + ;; ...and searches (broken separator keys send lookups into wrong subtree) |
| 74 | + (t/is (every? #(= % (:v (first (ds/datoms db0 :eavt 1 :vs %)))) evens)) |
| 75 | + (t/is (every? #(= % (:v (first (ds/datoms db0 :aevt :vs 1 %)))) evens)))) |
| 76 | + |
| 77 | +(deftest ^{:doc "issue-373 was originally reported on entities with |
| 78 | + :db.unique/identity attributes: check that transacting |
| 79 | + does not corrupt the AVET index of older db values"} |
| 80 | + issue-373-avet |
| 81 | + (let [schema {:login {:db/unique :db.unique/identity}} |
| 82 | + evens (range 0 8192 2) |
| 83 | + db0 (ds/db-with (ds/empty-db schema) |
| 84 | + (for [v evens] |
| 85 | + {:db/id (inc (quot v 2)) :login v})) |
| 86 | + _ (ds/db-with db0 |
| 87 | + (concat |
| 88 | + ;; new entities whose values land in the middle of db0’s avet tree |
| 89 | + (for [v (range 1 2048 2)] |
| 90 | + {:login v}) |
| 91 | + ;; retractions of datoms belonging to db0 |
| 92 | + (for [v (range 0 2048 2)] |
| 93 | + [:db/retract (inc (quot v 2)) :login v]) |
| 94 | + (for [v (range 8193 12288 2)] |
| 95 | + {:login v})))] |
| 96 | + (t/is (= evens (map :v (ds/datoms db0 :avet :login)))) |
| 97 | + ;; lookup refs resolve through avet, same path upserts take |
| 98 | + (t/is (every? #(= (inc (quot % 2)) (ds/entid db0 [:login %])) evens)))) |
| 99 | + |
| 100 | +(deftest ^{:doc "issue-373, suspected cause: transaction restart after upsert |
| 101 | + conflict (retry-with-tempid) abandons a transient session |
| 102 | + mid-flight. Neither the base db nor the restarted transaction |
| 103 | + should be affected by the abandoned edits"} |
| 104 | + issue-373-upsert-retry |
| 105 | + (let [schema {:name {:db/unique :db.unique/identity} |
| 106 | + :vs {:db/cardinality :db.cardinality/many}} |
| 107 | + evens (range 0 8192 2) |
| 108 | + db0 (ds/db-with (ds/empty-db schema) |
| 109 | + (concat |
| 110 | + [{:db/id 1 :name "target"}] |
| 111 | + (for [v evens] |
| 112 | + [:db/add 2 :vs v]))) |
| 113 | + report (ds/with db0 |
| 114 | + (concat |
| 115 | + ;; make the transient session edit trees shared with db0... |
| 116 | + (for [v (range 1 2048 2)] |
| 117 | + [:db/add 2 :vs v]) |
| 118 | + (for [v (range 0 2048 2)] |
| 119 | + [:db/retract 2 :vs v]) |
| 120 | + ;; ...then allocate a tempid and upsert it to an existing |
| 121 | + ;; entity, forcing a restart from the beginning |
| 122 | + [[:db/add -1 :age 37] |
| 123 | + [:db/add -1 :name "target"]])) |
| 124 | + db1 (:db-after report)] |
| 125 | + ;; retry resolved tempid to the upserted entity |
| 126 | + (t/is (= 1 (get-in report [:tempids -1]))) |
| 127 | + (t/is (= 37 (:age (ds/entity db1 1)))) |
| 128 | + ;; no leftover datoms from the abandoned first attempt |
| 129 | + (t/is (= [1] (map :e (ds/datoms db1 :aevt :age)))) |
| 130 | + (t/is (= (concat (range 1 2048 2) (range 2048 8192 2)) |
| 131 | + (map :v (ds/datoms db1 :eavt 2 :vs)))) |
| 132 | + ;; base db not corrupted by the abandoned transient session |
| 133 | + (t/is (= evens (map :v (ds/datoms db0 :eavt 2 :vs)))) |
| 134 | + (t/is (every? #(= % (:v (first (ds/datoms db0 :eavt 2 :vs %)))) evens)) |
| 135 | + (t/is (= 1 (ds/entid db0 [:name "target"]))))) |
| 136 | + |
| 137 | +(deftest ^{:doc "issue-373, reported scenario: corruption appeared in db values |
| 138 | + several transactions back. Chain transactions and verify every |
| 139 | + intermediate db against a snapshot taken right after its tx"} |
| 140 | + issue-373-history-chain |
| 141 | + (let [schema {:name {:db/unique :db.unique/identity} |
| 142 | + :vs {:db/cardinality :db.cardinality/many}} |
| 143 | + db0 (ds/db-with (ds/empty-db schema) |
| 144 | + (cons {:db/id 1 :name "n0"} |
| 145 | + (for [v (range 0 8192 2)] |
| 146 | + [:db/add 1 :vs v]))) |
| 147 | + snapshot (fn [db] |
| 148 | + {:db db |
| 149 | + :datoms (mapv (juxt :e :a :v) (ds/datoms db :eavt)) |
| 150 | + :vs (mapv :v (ds/datoms db :eavt 1 :vs))}) |
| 151 | + snapshots (reduce |
| 152 | + (fn [snapshots k] |
| 153 | + ;; each tx flips values 0..4095 to the opposite parity: |
| 154 | + ;; inserts and retractions all over the shared trees |
| 155 | + (let [[add remove] (if (odd? k) |
| 156 | + [(range 1 4096 2) (range 0 4096 2)] |
| 157 | + [(range 0 4096 2) (range 1 4096 2)]) |
| 158 | + ;; the entity map goes last: its datoms append at the |
| 159 | + ;; rightmost edge of the indexes, and an append as the |
| 160 | + ;; first op would path-copy the root before the middle |
| 161 | + ;; inserts get a chance to alias its arrays |
| 162 | + db' (ds/db-with (:db (peek snapshots)) |
| 163 | + (concat |
| 164 | + (for [v add] [:db/add 1 :vs v]) |
| 165 | + (for [v remove] [:db/retract 1 :vs v]) |
| 166 | + [{:name (str "n" k) :age k}]))] |
| 167 | + (conj snapshots (snapshot db')))) |
| 168 | + [(snapshot db0)] |
| 169 | + (range 1 9))] |
| 170 | + (doseq [[k {:keys [db datoms vs]}] (map vector (range) snapshots)] |
| 171 | + ;; each historical db still equals its own snapshot: iteration... |
| 172 | + (t/is (= datoms (mapv (juxt :e :a :v) (ds/datoms db :eavt))) (str "eavt after tx " k)) |
| 173 | + ;; ...and searches |
| 174 | + (t/is (every? #(= % (:v (first (ds/datoms db :eavt 1 :vs %)))) vs) (str "lookups after tx " k)) |
| 175 | + ;; entities reachable and complete, as in the original report |
| 176 | + (doseq [j (range 1 (inc k))] |
| 177 | + (t/is (= j (:age (ds/entity db [:name (str "n" j)]))) (str "entity n" j " after tx " k)))))) |
0 commit comments