Yet more unit tests, no new failures
This commit is contained in:
parent
a0882f7ebd
commit
4c5867b390
|
@ -75,25 +75,6 @@
|
||||||
#(index-vertex s o %)
|
#(index-vertex s o %)
|
||||||
(:vertices o)))}))
|
(:vertices o)))}))
|
||||||
|
|
||||||
;; (declare in-retrieve)
|
|
||||||
|
|
||||||
;; (defn in-retrieve-map
|
|
||||||
;; "Internal to `in-retrieve`, q.v. Handle the case where `x` is a map.
|
|
||||||
;; Separated out for debugging/unit testing purposes. Use at your own peril."
|
|
||||||
;; [x s]
|
|
||||||
;; (let [v (reduce
|
|
||||||
;; (fn [m k]
|
|
||||||
;; (assoc m k (in-retrieve (x k) s)))
|
|
||||||
;; {}
|
|
||||||
;; (keys (dissoc x :walkmap.id/id)))
|
|
||||||
;; id (:walkmap.id/id x)]
|
|
||||||
;; (if id
|
|
||||||
;; (assoc
|
|
||||||
;; v
|
|
||||||
;; :walkmap.id/id
|
|
||||||
;; (:walkmap.id/id x))))
|
|
||||||
;; )
|
|
||||||
|
|
||||||
(defn in-retrieve
|
(defn in-retrieve
|
||||||
"Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a
|
"Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a
|
||||||
walkmap superstructure. TODO: recursive, quite likely to blow the fragile
|
walkmap superstructure. TODO: recursive, quite likely to blow the fragile
|
||||||
|
@ -119,6 +100,7 @@
|
||||||
:walkmap.id/id
|
:walkmap.id/id
|
||||||
(:walkmap.id/id x))
|
(:walkmap.id/id x))
|
||||||
v))
|
v))
|
||||||
|
(set? x) x ;; TODO: should I search in sets for objects when storing?
|
||||||
(coll? x) (map #(in-retrieve % s) x)
|
(coll? x) (map #(in-retrieve % s) x)
|
||||||
:else x))
|
:else x))
|
||||||
|
|
||||||
|
@ -136,6 +118,7 @@
|
||||||
([o s]
|
([o s]
|
||||||
(l/debug "Finding objects in:" o)
|
(l/debug "Finding objects in:" o)
|
||||||
(cond
|
(cond
|
||||||
|
(set? o) s ;; TODO: should I search in sets for objects when storing?
|
||||||
(map? o) (if (:walkmap.id/id o)
|
(map? o) (if (:walkmap.id/id o)
|
||||||
(assoc
|
(assoc
|
||||||
(in-store-find-objects (vals o) s)
|
(in-store-find-objects (vals o) s)
|
||||||
|
|
|
@ -4,6 +4,7 @@
|
||||||
[walkmap.path :as p]
|
[walkmap.path :as p]
|
||||||
[walkmap.polygon :as q]
|
[walkmap.polygon :as q]
|
||||||
[walkmap.superstructure :refer :all]
|
[walkmap.superstructure :refer :all]
|
||||||
|
[walkmap.tag :as t]
|
||||||
[walkmap.utils :as u]
|
[walkmap.utils :as u]
|
||||||
[walkmap.vertex :as v]))
|
[walkmap.vertex :as v]))
|
||||||
|
|
||||||
|
@ -45,9 +46,9 @@
|
||||||
;; the value of `s` here is hand-typed; think of it as a specification
|
;; the value of `s` here is hand-typed; think of it as a specification
|
||||||
(let [s {:path1 {:walkmap.id/id :path1
|
(let [s {:path1 {:walkmap.id/id :path1
|
||||||
:kind :path
|
:kind :path
|
||||||
:vertices [:vert_0_0_0
|
:vertices '(:vert_0_0_0
|
||||||
:vert_0_0_1
|
:vert_0_0_1
|
||||||
:vert_1_0_0]}
|
:vert_1_0_0)}
|
||||||
:vert_0_0_0 {:walkmap.id/id :vert_0_0_0
|
:vert_0_0_0 {:walkmap.id/id :vert_0_0_0
|
||||||
:kind :vertex
|
:kind :vertex
|
||||||
:x 0
|
:x 0
|
||||||
|
@ -68,9 +69,67 @@
|
||||||
:vert_1_0_0 {:path1 :vert_1_0_0}}}
|
:vert_1_0_0 {:path1 :vert_1_0_0}}}
|
||||||
expected {:kind :path,
|
expected {:kind :path,
|
||||||
:vertices
|
:vertices
|
||||||
({:kind :vertex, :x 0, :y 0, :z 0, :walkmap.id/id :vert_0_0_0}
|
'({:kind :vertex, :x 0, :y 0, :z 0, :walkmap.id/id :vert_0_0_0}
|
||||||
{:kind :vertex, :x 0, :y 0, :z 1, :walkmap.id/id :vert_0_0_1}
|
{:kind :vertex, :x 0, :y 0, :z 1, :walkmap.id/id :vert_0_0_1}
|
||||||
{:kind :vertex, :x 1, :y 0, :z 0, :walkmap.id/id :vert_1_0_0}),
|
{:kind :vertex, :x 1, :y 0, :z 0, :walkmap.id/id :vert_1_0_0}),
|
||||||
:walkmap.id/id :path1}]
|
:walkmap.id/id :path1}]
|
||||||
(is (= (retrieve :path1 s) expected)
|
(is (= (retrieve :path1 s) expected)
|
||||||
"The object reconstructed from the superstructure."))))
|
"The object reconstructed from the superstructure."))))
|
||||||
|
|
||||||
|
(deftest round-trip-test
|
||||||
|
(testing "Roundtripping an object through the superstructure."
|
||||||
|
(let [p (p/path
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand)))
|
||||||
|
id (:walkmap.id/id p)
|
||||||
|
s (store p)
|
||||||
|
r (retrieve id s)]
|
||||||
|
(is (= p r) "As it was, so it shall be."))))
|
||||||
|
|
||||||
|
(deftest multi-object-round-trip-test
|
||||||
|
(testing "Roundtripping two different objects through a superstructure."
|
||||||
|
(let [p (p/path
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand)))
|
||||||
|
q (p/path
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand)))
|
||||||
|
pid (:walkmap.id/id p)
|
||||||
|
qid (:walkmap.id/id q)
|
||||||
|
s (store q (store p))
|
||||||
|
rp (retrieve pid s)
|
||||||
|
rq (retrieve qid s)]
|
||||||
|
(is (= p rp) "As `p` was, so it shall be.")
|
||||||
|
(is (= q rq) "As `q` was, so it shall be.")
|
||||||
|
(is (not= pid qid)
|
||||||
|
"It is not possible that the ids should be equal, since they are
|
||||||
|
gensymmed")
|
||||||
|
(is (not= rp rq)
|
||||||
|
"It is not possible that the paths should be equal, since at
|
||||||
|
minimum, their ids are gensymmed."))))
|
||||||
|
|
||||||
|
(deftest store-retrieve-edit-store-test
|
||||||
|
(testing "After editing a retrieved object and storing it again, a further
|
||||||
|
retrieve should return the new version."
|
||||||
|
(let [p (p/path
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand))
|
||||||
|
(v/vertex (rand) (rand) (rand)))
|
||||||
|
id (:walkmap.id/id p)
|
||||||
|
o (store p)
|
||||||
|
r (retrieve id o)
|
||||||
|
p' (t/tag
|
||||||
|
(assoc r :vertices
|
||||||
|
(conj (:vertices id) (v/vertex (rand) (rand) (rand))))
|
||||||
|
:edited)
|
||||||
|
o' (store p' o)
|
||||||
|
r' (retrieve id o')]
|
||||||
|
(is (not= r r') "The value referenced by `id` should have changed.")
|
||||||
|
(is (= r' p') "The value referenced by `id` in `o'` should be equal to `p'`."))))
|
||||||
|
|
Loading…
Reference in a new issue