#3: Written many unit tests (good). Some fail (bad).
This commit is contained in:
parent
f93432a241
commit
a0882f7ebd
|
@ -24,6 +24,8 @@
|
||||||
;; superstructure - unless we replace the superstructure altogether with a
|
;; superstructure - unless we replace the superstructure altogether with a
|
||||||
;; database, which may be the Right Thing To Do.
|
;; database, which may be the Right Thing To Do.
|
||||||
|
|
||||||
|
(def vertex-index ::vertex-index)
|
||||||
|
|
||||||
(defn vertices
|
(defn vertices
|
||||||
"If `o` is an object with vertices, return those vertices, else nil."
|
"If `o` is an object with vertices, return those vertices, else nil."
|
||||||
[o]
|
[o]
|
||||||
|
@ -44,7 +46,7 @@
|
||||||
(if-not (v/vertex? o)
|
(if-not (v/vertex? o)
|
||||||
(if (:walkmap.id/id o)
|
(if (:walkmap.id/id o)
|
||||||
(if (v/vertex? v)
|
(if (v/vertex? v)
|
||||||
(let [vi (or (:vertex-index s) {})
|
(let [vi (or (::vertex-index s) {})
|
||||||
current (or (vi (:walkmap.id/id v)) {})]
|
current (or (vi (:walkmap.id/id v)) {})]
|
||||||
;; deep-merge doesn't merge sets, only maps; so at this
|
;; deep-merge doesn't merge sets, only maps; so at this
|
||||||
;; stage we need to build a map.
|
;; stage we need to build a map.
|
||||||
|
@ -53,7 +55,7 @@
|
||||||
(throw (IllegalArgumentException. (u/truncate (str "No `:walkmap.id/id` value: " o) 80))))
|
(throw (IllegalArgumentException. (u/truncate (str "No `:walkmap.id/id` value: " o) 80))))
|
||||||
;; it shouldn't actually be an error to try to index a vertex, but it
|
;; it shouldn't actually be an error to try to index a vertex, but it
|
||||||
;; also isn't useful to do so, so I'd be inclined to ignore it.
|
;; also isn't useful to do so, so I'd be inclined to ignore it.
|
||||||
(:vertex-index s)))
|
(::vertex-index s)))
|
||||||
|
|
||||||
(defn index-vertices
|
(defn index-vertices
|
||||||
"Return a superstructure like `s` in which object `o` is indexed by its
|
"Return a superstructure like `s` in which object `o` is indexed by its
|
||||||
|
@ -65,7 +67,7 @@
|
||||||
[s o]
|
[s o]
|
||||||
(u/deep-merge
|
(u/deep-merge
|
||||||
s
|
s
|
||||||
{:vertex-index
|
{::vertex-index
|
||||||
(reduce
|
(reduce
|
||||||
u/deep-merge
|
u/deep-merge
|
||||||
{}
|
{}
|
||||||
|
@ -73,21 +75,24 @@
|
||||||
#(index-vertex s o %)
|
#(index-vertex s o %)
|
||||||
(:vertices o)))}))
|
(:vertices o)))}))
|
||||||
|
|
||||||
(defn in-retrieve-map
|
;; (declare in-retrieve)
|
||||||
"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."
|
;; (defn in-retrieve-map
|
||||||
[x s]
|
;; "Internal to `in-retrieve`, q.v. Handle the case where `x` is a map.
|
||||||
(let [v (reduce
|
;; Separated out for debugging/unit testing purposes. Use at your own peril."
|
||||||
(fn [m k]
|
;; [x s]
|
||||||
(assoc m k (in-retrieve (x k) s)))
|
;; (let [v (reduce
|
||||||
{}
|
;; (fn [m k]
|
||||||
(keys (dissoc x :walkmap.id/id)))
|
;; (assoc m k (in-retrieve (x k) s)))
|
||||||
id (:walkmap.id/id x)]
|
;; {}
|
||||||
(if id
|
;; (keys (dissoc x :walkmap.id/id)))
|
||||||
(assoc
|
;; id (:walkmap.id/id x)]
|
||||||
v
|
;; (if id
|
||||||
:walkmap.id/id
|
;; (assoc
|
||||||
(:walkmap.id/id x)))))
|
;; 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
|
||||||
|
@ -101,7 +106,19 @@
|
||||||
(in-retrieve (s x) s)
|
(in-retrieve (s x) s)
|
||||||
x)
|
x)
|
||||||
;; if it's a map, for every key which is not `:walkmap.id/id`, recurse.
|
;; if it's a map, for every key which is not `:walkmap.id/id`, recurse.
|
||||||
(map? x) (in-retrieve-map x s)
|
(map? x) (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 it has an id, bind it to that id in the returned value.
|
||||||
|
(if id
|
||||||
|
(assoc
|
||||||
|
v
|
||||||
|
:walkmap.id/id
|
||||||
|
(:walkmap.id/id x))
|
||||||
|
v))
|
||||||
(coll? x) (map #(in-retrieve % s) x)
|
(coll? x) (map #(in-retrieve % s) x)
|
||||||
:else x))
|
:else x))
|
||||||
|
|
||||||
|
@ -166,7 +183,7 @@
|
||||||
(u/deep-merge s (in-store-find-objects o))
|
(u/deep-merge s (in-store-find-objects o))
|
||||||
(:walkmap.id/id o)
|
(:walkmap.id/id o)
|
||||||
(in-store-replace-with-keys o)
|
(in-store-replace-with-keys o)
|
||||||
:vertex-index
|
::vertex-index
|
||||||
(u/deep-merge
|
(u/deep-merge
|
||||||
(index-vertices s o)
|
(index-vertices s o)
|
||||||
(:vertex-index s)))))
|
(::vertex-index s)))))
|
||||||
|
|
76
test/walkmap/superstructure_test.clj
Normal file
76
test/walkmap/superstructure_test.clj
Normal file
|
@ -0,0 +1,76 @@
|
||||||
|
(ns walkmap.superstructure-test
|
||||||
|
(:require [clojure.set :refer [subset?]]
|
||||||
|
[clojure.test :refer :all]
|
||||||
|
[walkmap.path :as p]
|
||||||
|
[walkmap.polygon :as q]
|
||||||
|
[walkmap.superstructure :refer :all]
|
||||||
|
[walkmap.utils :as u]
|
||||||
|
[walkmap.vertex :as v]))
|
||||||
|
|
||||||
|
(deftest store-test
|
||||||
|
(testing "Object storage"
|
||||||
|
(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 (id s)]
|
||||||
|
(is (= (:walkmap.id/id r) id)
|
||||||
|
"A representation should be stored in `s` keyed by `id`, and the id of that representation should be `id`.")
|
||||||
|
(is (= (:kind r) (:kind p))
|
||||||
|
"The representation should have the same value for `:kind`.")
|
||||||
|
(is (= (count (:vertices p)) (count (:vertices r)))
|
||||||
|
"The representation of `p` in `s` should have the same number of vertices as `p`.")
|
||||||
|
(is (every? v/vertex? (:vertices p))
|
||||||
|
"Every vertex of `p` should be a vertex.")
|
||||||
|
(is (every? keyword? (:vertices r))
|
||||||
|
"Every vertex of the representation of `p` in `s` should be a keyword.")
|
||||||
|
(is (every? v/vertex? (map #(s %) (:vertices r)))
|
||||||
|
"The value in `s` of every vertex of the representation of `p` in `s`
|
||||||
|
should be a vertex.")
|
||||||
|
(is (subset? (set (:vertices r)) (set (keys (vertex-index s))))
|
||||||
|
"All the keys which are vertices of the representation of `p` in `s`
|
||||||
|
should be present as keys in the vertex-index of `s`.")
|
||||||
|
(is (every?
|
||||||
|
#(s (% id))
|
||||||
|
(map #(set (keys (% (vertex-index s)))) (:vertices r)))
|
||||||
|
"The value in the vertex-index in `s` for each keyword in the
|
||||||
|
vertexes of the representation of `p` in `s` should include,
|
||||||
|
as a key, the `id` of `p`."))))
|
||||||
|
|
||||||
|
(deftest retrieve-test
|
||||||
|
(testing "Object retrieval"
|
||||||
|
;; the value of `s` here is hand-typed; think of it as a specification
|
||||||
|
(let [s {:path1 {:walkmap.id/id :path1
|
||||||
|
:kind :path
|
||||||
|
:vertices [:vert_0_0_0
|
||||||
|
:vert_0_0_1
|
||||||
|
:vert_1_0_0]}
|
||||||
|
:vert_0_0_0 {:walkmap.id/id :vert_0_0_0
|
||||||
|
:kind :vertex
|
||||||
|
:x 0
|
||||||
|
:y 0
|
||||||
|
:z 0}
|
||||||
|
:vert_0_0_1 {:walkmap.id/id :vert_0_0_1
|
||||||
|
:kind :vertex
|
||||||
|
:x 0
|
||||||
|
:y 0
|
||||||
|
:z 1}
|
||||||
|
:vert_1_0_0 {:walkmap.id/id :vert_1_0_0
|
||||||
|
:kind :vertex
|
||||||
|
:x 1
|
||||||
|
:y 0
|
||||||
|
:z 0}
|
||||||
|
:walkmap.superstructure/vertex-index {:vert_0_0_0 {:path1 :vert_0_0_0}
|
||||||
|
:vert_0_0_1 {:path1 :vert_0_0_1}
|
||||||
|
:vert_1_0_0 {:path1 :vert_1_0_0}}}
|
||||||
|
expected {:kind :path,
|
||||||
|
:vertices
|
||||||
|
({: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 1, :y 0, :z 0, :walkmap.id/id :vert_1_0_0}),
|
||||||
|
:walkmap.id/id :path1}]
|
||||||
|
(is (= (retrieve :path1 s) expected)
|
||||||
|
"The object reconstructed from the superstructure."))))
|
Loading…
Reference in a new issue