From a0882f7ebdc753251f78cc4b09c58b14244c488a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 30 May 2020 15:51:21 +0100 Subject: [PATCH] #3: Written many unit tests (good). Some fail (bad). --- src/walkmap/superstructure.clj | 59 +++++++++++++-------- test/walkmap/superstructure_test.clj | 76 ++++++++++++++++++++++++++++ 2 files changed, 114 insertions(+), 21 deletions(-) create mode 100644 test/walkmap/superstructure_test.clj diff --git a/src/walkmap/superstructure.clj b/src/walkmap/superstructure.clj index 85ac57d..d73d688 100644 --- a/src/walkmap/superstructure.clj +++ b/src/walkmap/superstructure.clj @@ -24,6 +24,8 @@ ;; superstructure - unless we replace the superstructure altogether with a ;; database, which may be the Right Thing To Do. +(def vertex-index ::vertex-index) + (defn vertices "If `o` is an object with vertices, return those vertices, else nil." [o] @@ -44,7 +46,7 @@ (if-not (v/vertex? o) (if (:walkmap.id/id o) (if (v/vertex? v) - (let [vi (or (:vertex-index s) {}) + (let [vi (or (::vertex-index s) {}) current (or (vi (:walkmap.id/id v)) {})] ;; deep-merge doesn't merge sets, only maps; so at this ;; stage we need to build a map. @@ -53,7 +55,7 @@ (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 ;; also isn't useful to do so, so I'd be inclined to ignore it. - (:vertex-index s))) + (::vertex-index s))) (defn index-vertices "Return a superstructure like `s` in which object `o` is indexed by its @@ -65,7 +67,7 @@ [s o] (u/deep-merge s - {:vertex-index + {::vertex-index (reduce u/deep-merge {} @@ -73,21 +75,24 @@ #(index-vertex s o %) (:vertices o)))})) -(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))))) +;; (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 "Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a @@ -101,7 +106,19 @@ (in-retrieve (s x) s) x) ;; 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) :else x)) @@ -166,7 +183,7 @@ (u/deep-merge s (in-store-find-objects o)) (:walkmap.id/id o) (in-store-replace-with-keys o) - :vertex-index + ::vertex-index (u/deep-merge (index-vertices s o) - (:vertex-index s))))) + (::vertex-index s))))) diff --git a/test/walkmap/superstructure_test.clj b/test/walkmap/superstructure_test.clj new file mode 100644 index 0000000..44e866e --- /dev/null +++ b/test/walkmap/superstructure_test.clj @@ -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."))))