From 839f11008be96f5df39a350bdb653aa2d0baeb94 Mon Sep 17 00:00:00 2001 From: Andy Chambers Date: Sat, 3 Sep 2016 13:09:01 -0700 Subject: [PATCH] Add genertive test for sqlite backend --- env/profiling/hitchhiker/bench.clj | 143 ++++++++++++++--------------- src/hitchhiker/sqlite.clj | 52 +++++++++-- test/hitchhiker/sqlite_test.clj | 59 ++++++++++++ 3 files changed, 174 insertions(+), 80 deletions(-) diff --git a/env/profiling/hitchhiker/bench.clj b/env/profiling/hitchhiker/bench.clj index 63c87dc..6339c94 100644 --- a/env/profiling/hitchhiker/bench.clj +++ b/env/profiling/hitchhiker/bench.clj @@ -196,77 +196,76 @@ (defn -main [& [root & args]] - (jdbc/with-db-connection [db (sqlite/db-spec ":memory:")] - (let [outputs (atom [])] - (doseq [args (or (->> args - (partition-by #(= % "--")) - (map-indexed vector) - (filter (comp even? first)) - (map second) - (seq)) - [[]])] ; always do one iteration - (let [{:keys [options arguments errors summary]} (parse-opts args options) - tree-to-test (atom {}) - results (atom [])] - (cond - (or (= "-h" root) - (= "--help" root) - (nil? root) - (:help options)) (exit 0 (usage summary)) - (not= (count arguments) 0) (exit 1 (usage summary)) - errors (exit 1 (error-msg errors))) - (let [backend (case (:backend options) - "testing" (core/->TestingBackend) - "redis" (do (redis/start-expiry-thread!) - (redis/->RedisBackend)) - "sqlite" (do (sqlite/ensure-schema db) - (sqlite/->SQLiteBackend db))) - delete-xform (case (:delete-pattern options) - "forward" identity - "reverse" reverse - "shuffle" shuffle - "zero" #(repeat (count %) 0.0)) - [tree-name structure] - (case (:data-structure options) - "b-tree" ["b-tree" (core-b-tree (:tree-width options) backend)] - "fractal" ["fractal" (msg-b-tree (:tree-width options) backend)] - "sorted-set" ["sorted-set" (sorted-set-repr)]) - flush-freq (:flush-freq options) - codename (str tree-name - "__flush_" - flush-freq - "__b_" - (:tree-width options) - "__" - (:backend options) - "__n_" - (:num-operations options) - "__del_" - (:delete-pattern options))] - (doseq [ds (generate-test-datasets) - :let [codename (str codename - "_" - (:name ds)) - out (create-output-dir - root - codename) - _ (println "Doing" codename) - bench-res (benchmark (:num-operations options) ds flush-freq structure out delete-xform)]] - (swap! results conj - {:tree tree-name - :ds (:name ds) - :freq flush-freq - :n (:num-operations options) - :b (:tree-width options) - :delete-pattern (:delete-pattern options) - :results bench-res})) + (let [outputs (atom [])] + (doseq [args (or (->> args + (partition-by #(= % "--")) + (map-indexed vector) + (filter (comp even? first)) + (map second) + (seq)) + [[]])] ; always do one iteration + (let [{:keys [options arguments errors summary]} (parse-opts args options) + tree-to-test (atom {}) + results (atom [])] + (cond + (or (= "-h" root) + (= "--help" root) + (nil? root) + (:help options)) (exit 0 (usage summary)) + (not= (count arguments) 0) (exit 1 (usage summary)) + errors (exit 1 (error-msg errors))) + (let [backend (case (:backend options) + "testing" (core/->TestingBackend) + "redis" (do (redis/start-expiry-thread!) + (redis/->RedisBackend)) + "sqlite" (sqlite/->SQLiteBackend + (sqlite/find-or-create-db "/tmp/yolo.sqlite"))) + delete-xform (case (:delete-pattern options) + "forward" identity + "reverse" reverse + "shuffle" shuffle + "zero" #(repeat (count %) 0.0)) + [tree-name structure] + (case (:data-structure options) + "b-tree" ["b-tree" (core-b-tree (:tree-width options) backend)] + "fractal" ["fractal" (msg-b-tree (:tree-width options) backend)] + "sorted-set" ["sorted-set" (sorted-set-repr)]) + flush-freq (:flush-freq options) + codename (str tree-name + "__flush_" + flush-freq + "__b_" + (:tree-width options) + "__" + (:backend options) + "__n_" + (:num-operations options) + "__del_" + (:delete-pattern options))] + (doseq [ds (generate-test-datasets) + :let [codename (str codename + "_" + (:name ds)) + out (create-output-dir + root + codename) + _ (println "Doing" codename) + bench-res (benchmark (:num-operations options) ds flush-freq structure out delete-xform)]] + (swap! results conj + {:tree tree-name + :ds (:name ds) + :freq flush-freq + :n (:num-operations options) + :b (:tree-width options) + :delete-pattern (:delete-pattern options) + :results bench-res})) ;(println "results") ;(clojure.pprint/pprint @results) - (swap! outputs conj (template-one-sheet @results))))) - (excel/render-to-file - "template_benchmark.xlsx" - (.getPath (File. root "analysis.xlsx")) - {"SingleDS" - (map-indexed (fn [i s] - (assoc s :sheet-name (str "Trial " (inc i)))) - @outputs)})))) + (swap! outputs conj (template-one-sheet @results))))) + (excel/render-to-file + "template_benchmark.xlsx" + (.getPath (File. root "analysis.xlsx")) + {"SingleDS" + (map-indexed (fn [i s] + (assoc s :sheet-name (str "Trial " (inc i)))) + @outputs)}))) diff --git a/src/hitchhiker/sqlite.clj b/src/hitchhiker/sqlite.clj index 2a95940..c3611e5 100644 --- a/src/hitchhiker/sqlite.clj +++ b/src/hitchhiker/sqlite.clj @@ -28,10 +28,19 @@ (def query {:table-exists? "select 1 from sqlite_master where type='table' and name=?" :index-exists? "select 1 from sqlite_master where type='index' and name=?" - :find-key "select * from hh_key where k=?"}) + :find-key "select * from hh_key where k=?" + :dead-keys "select k + from hh_key + where k not in ( select child from hh_ref )"}) (defn drop-ref [db key] - (jdbc/delete! db :hh-key ["k = ?" key])) + (jdbc/delete! db :hh-key ["k = ?" key] + {:entities underscore}) + + (let [dead-keys (jdbc/query db (query :dead-keys))] + (doseq [{:keys [k] :as dead-key} dead-keys] + (drop-ref db k)))) + (defn db-spec [subname] {:classname "org.sqlite.JDBC" @@ -86,7 +95,22 @@ (ensure {:items [:hh-ref-by-parent :hh-ref-by-child] :exists? index-exists? - :create! create-index}))) + :create! create-index}) + + db)) + +(defonce ^:private db-registry (atom {})) + +(defn find-db [subname] + (get @db-registry subname)) + +(defn create-db [subname] + (-> {:connection (jdbc/get-connection (db-spec subname))} + (ensure-schema))) + +(defn find-or-create-db [subname] + (or (find-db subname) + (create-db subname))) (defn add-node [db {:keys [k v] :as node}] (try @@ -96,16 +120,25 @@ {:node node :db db} e))))) +(defn list-keys [db] + (jdbc/query db "select k from hh_key")) + (defn delete-key [db k] (jdbc/delete! :hh-key ["k = ?" k])) (defn add-refs [db {:keys [parent children]}] (let [mk-ref (fn [child] [parent child])] - (jdbc/insert-multi! db :hh-ref (for [child children] - {:parent parent - :child child}) - {:entities underscore}))) + (try + (jdbc/insert-multi! db :hh-ref (for [child children] + {:parent parent + :child child}) + {:entities underscore}) + (catch Exception e + (throw (ex-info "Failed to link parent with children" + {:parent parent + :children children} + e)))))) (defn synthesize-storage-addr "Given a key, returns a promise containing that key for use as a storage-addr" @@ -113,6 +146,10 @@ (doto (promise) (deliver key))) +;;; TODO: I believe using a dynamic var to hold the DB is a bit of anti-pattern but +;;; not sure how to avoid it and still support caching as it behaves in the +;;; redis backend. +;;; (def ^:dynamic *db*) (let [cache (-> {} @@ -167,7 +204,6 @@ (new-session [_] (atom {:writes 0 :deletes 0})) (anchor-root [_ {:keys [sqlite-key] :as node}] - ;; TODO: figure out how redis gc relates to SQL node) (write-node [_ node session] (swap! session update-in [:writes] inc) diff --git a/test/hitchhiker/sqlite_test.clj b/test/hitchhiker/sqlite_test.clj index e69de29..cb70a12 100644 --- a/test/hitchhiker/sqlite_test.clj +++ b/test/hitchhiker/sqlite_test.clj @@ -0,0 +1,59 @@ +(ns hitchhiker.sqlite-test + (:require [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [hitchhiker.sqlite :as sqlite] + [hitchhiker.tree.core :as core] + hitchhiker.tree.core-test + [hitchhiker.tree.messaging :as msg] + [clojure.java.jdbc :as jdbc])) + +(defn insert + [t k] + (msg/insert t k k)) + +(defn lookup-fwd-iter + [t v] + (seq (map first (msg/lookup-fwd-iter t v)))) + +(defn mixed-op-seq + "This is like the basic mixed-op-seq tests, but it also mixes in flushes to sqlite + and automatically deletes the old tree" + [add-freq del-freq flush-freq universe-size num-ops] + (let [db (sqlite/find-or-create-db "/tmp/yolo.sqlite")] + (prop/for-all [ops (gen/vector (gen/frequency + [[add-freq (gen/tuple (gen/return :add) + (gen/no-shrink gen/int))] + [flush-freq (gen/return [:flush])] + [del-freq (gen/tuple (gen/return :del) + (gen/no-shrink gen/int))]]) + 40)] + (assert (empty? (sqlite/list-keys db)) + "Start with no keys") + (let [[b-tree root set] + (reduce (fn [[t root set] [op x]] + (let [x-reduced (when x (mod x universe-size))] + (condp = op + :flush (let [t (:tree (core/flush-tree t (sqlite/->SQLiteBackend db)))] + (when root + (sqlite/drop-ref db root)) + #_(println "flush" root) + [t @(:storage-addr t) set]) + :add (do #_(println "add" x) [(insert t x-reduced) root (conj set x-reduced)]) + :del (do #_(println "del" x) [(msg/delete t x-reduced) root (disj set x-reduced)])))) + [(core/b-tree (core/->Config 3 3 2)) nil #{}] + ops)] + #_(println "Make it to the end of a test," root "has" (count (lookup-fwd-iter b-tree -1)) "keys left") + (let [b-tree-order (lookup-fwd-iter b-tree -1) + res (= b-tree-order (seq (sort set)))] + + (sqlite/drop-ref db root) + (assert (empty? (sqlite/list-keys db)) + "End with no keys") + + (assert res (str "These are unequal: " (pr-str b-tree-order) " " (pr-str (seq (sort set))))) + res))))) + +(defspec test-many-keys-bigger-trees + 100 + (mixed-op-seq 800 200 10 1000 1000))