|
| 1 | +(ns hitchhiker.s3-test |
| 2 | + (:require [amazonica.core :refer [with-credential]] |
| 3 | + [amazonica.aws.s3 :as s3] |
| 4 | + [clojure.test :refer [use-fixtures]] |
| 5 | + [clojure.test.check.clojure-test :refer [defspec]] |
| 6 | + [clojure.test.check.generators :as gen] |
| 7 | + [clojure.test.check.properties :as prop] |
| 8 | + [hitchhiker.s3 :as hhs3] |
| 9 | + [hitchhiker.tree.core :as core] |
| 10 | + hitchhiker.tree.core-test |
| 11 | + [hitchhiker.tree.messaging :as msg])) |
| 12 | + |
| 13 | +(defn setup-fake-s3 |
| 14 | + [f] |
| 15 | + (let [port (+ 10000 (rand-int 1024)) |
| 16 | + test-dir (str "s3-test-" (gensym)) |
| 17 | + proc (.exec (Runtime/getRuntime) (into-array ^String ["fakes3" |
| 18 | + "server" |
| 19 | + "-p" (str port) |
| 20 | + "-r" test-dir]))] |
| 21 | + (with-credential {:endpoint (str "http://localhost:" port)} |
| 22 | + (s3/set-s3client-options :path-style-access true) |
| 23 | + (s3/create-bucket "test-bucket") |
| 24 | + (f)) |
| 25 | + (.destroy proc) |
| 26 | + (let [func (fn [func f] |
| 27 | + (when (.isDirectory f) |
| 28 | + (doseq [f2 (.listFiles f)] |
| 29 | + (func func f2))) |
| 30 | + (clojure.java.io/delete-file f))] |
| 31 | + (func func (clojure.java.io/file test-dir))))) |
| 32 | + |
| 33 | +(use-fixtures :once setup-fake-s3) |
| 34 | + |
| 35 | +(defn insert |
| 36 | + [t k] |
| 37 | + (msg/insert t k k)) |
| 38 | + |
| 39 | +(defn lookup-fwd-iter |
| 40 | + [t v] |
| 41 | + (seq (map first (msg/lookup-fwd-iter t v)))) |
| 42 | + |
| 43 | +(defn mixed-op-seq |
| 44 | + "This is like the basic mixed-op-seq tests, but it also mixes in flushes to redis |
| 45 | + and automatically deletes the old tree" |
| 46 | + [add-freq del-freq flush-freq universe-size num-ops] |
| 47 | + (prop/for-all [ops (gen/vector (gen/frequency |
| 48 | + [[add-freq (gen/tuple (gen/return :add) |
| 49 | + (gen/no-shrink gen/int))] |
| 50 | + [flush-freq (gen/return [:flush])] |
| 51 | + [del-freq (gen/tuple (gen/return :del) |
| 52 | + (gen/no-shrink gen/int))]]) |
| 53 | + 0)] |
| 54 | + (assert (let [ks (:object-summaries (s3/list-objects "test-bucket"))] |
| 55 | + (empty? ks)) |
| 56 | + "Start with no keys") |
| 57 | + (let [[b-tree root set] |
| 58 | + (reduce (fn [[t root set] [op x]] |
| 59 | + (let [x-reduced (when x (mod x universe-size))] |
| 60 | + (condp = op |
| 61 | + :flush (let [t (:tree (core/flush-tree t (hhs3/->S3Backend "test-bucket")))] |
| 62 | + #_(when root |
| 63 | + (wcar {} (redis/drop-ref root))) |
| 64 | + #_(println "flush") |
| 65 | + [t @(:storage-addr t) set]) |
| 66 | + :add (do #_(println "add") [(insert t x-reduced) root (conj set x-reduced)]) |
| 67 | + :del (do #_(println "del") [(msg/delete t x-reduced) root (disj set x-reduced)])))) |
| 68 | + [(core/b-tree (core/->Config 3 3 2)) nil #{}] |
| 69 | + ops)] |
| 70 | + #_(println "Make it to the end of a test, tree has" (count (lookup-fwd-iter b-tree -1)) "keys left") |
| 71 | + (let [b-tree-order (lookup-fwd-iter b-tree -1) |
| 72 | + res (= b-tree-order (seq (sort set)))] |
| 73 | + #_(wcar {} (redis/drop-ref root)) |
| 74 | + (assert (let [ks (:object-summaries (s3/list-objects "test-bucket"))] |
| 75 | + (empty? ks)) |
| 76 | + "End with no keys") |
| 77 | + (assert res (str "These are unequal: " (pr-str b-tree-order) " " (pr-str (seq (sort set))))) |
| 78 | + res)))) |
| 79 | + |
| 80 | +(defspec test-many-keys-bigger-trees |
| 81 | + 100 |
| 82 | + (mixed-op-seq 800 200 10 1000 1000)) |
| 83 | + |
| 84 | +(comment |
| 85 | + (test-many-keys-bigger-trees) |
| 86 | + |
| 87 | + |
| 88 | + (count (remove (reduce (fn [t [op x]] |
| 89 | + (let [x-reduced (when x (mod x 1000))] |
| 90 | + (condp = op |
| 91 | + :flush t |
| 92 | + :add (conj t x-reduced) |
| 93 | + :del (disj t x-reduced)))) |
| 94 | + #{} |
| 95 | + (drop-last 2 opseq)) (lookup-fwd-iter (msg/delete test-tree -33) 0))) |
| 96 | + (:op-buf test-tree) |
| 97 | + (count (sort (reduce (fn [t [op x]] |
| 98 | + (let [x-reduced (when x (mod x 1000))] |
| 99 | + (condp = op |
| 100 | + :flush t |
| 101 | + :add (conj t x-reduced) |
| 102 | + :del (disj t x-reduced)))) |
| 103 | + #{} |
| 104 | + opseq))) |
| 105 | + |
| 106 | + |
| 107 | + (let [ops (->> (read-string (slurp "broken-data.edn")) |
| 108 | + (map (fn [[op x]] [op (mod x 100000)])) |
| 109 | + (drop-last 125))] |
| 110 | + (let [[b-tree s] (reduce (fn [[t s] [op x]] |
| 111 | + (let [x-reduced (mod x 100000)] |
| 112 | + (condp = op |
| 113 | + :add [(insert t x-reduced) |
| 114 | + (conj s x-reduced)] |
| 115 | + :del [(msg/delete t x-reduced) |
| 116 | + (disj s x-reduced)]))) |
| 117 | + [(core/b-tree (core/->Config 3 3 2)) #{}] |
| 118 | + ops)] |
| 119 | + (println ops) |
| 120 | + (println (->> (read-string (slurp "broken-data.edn")) |
| 121 | + (map (fn [[op x]] [op (mod x 100000)])) |
| 122 | + (take-last 125) |
| 123 | + first)) |
| 124 | + (println (lookup-fwd-iter b-tree -1)) |
| 125 | + (println (sort s)) |
| 126 | + )) |
| 127 | + (defn trial [] |
| 128 | + (let [opseq (read-string (slurp "broken-data.edn")) |
| 129 | + [b-tree root] (reduce (fn [[t root] [op x]] |
| 130 | + (let [x-reduced (when x (mod x 1000))] |
| 131 | + (condp = op |
| 132 | + :flush (let [_ (println "About to flush...") |
| 133 | + t (:tree (core/flush-tree t (hhs3/->S3Backend "test-bucket")))] |
| 134 | + #_(when root |
| 135 | + (wcar {} (redis/drop-ref root))) |
| 136 | + (println "flushed") |
| 137 | + [t @(:storage-addr t)]) |
| 138 | + :add (do (println "about to add" x-reduced "...") |
| 139 | + (let [x [(insert t x-reduced) root]] |
| 140 | + (println "added") x |
| 141 | + )) |
| 142 | + :del (do (println "about to del" x-reduced "...") |
| 143 | + (let [x [(msg/delete t x-reduced) root]] |
| 144 | + (println "deled") x))))) |
| 145 | + [(core/b-tree (core/->Config 3 3 2))] |
| 146 | + opseq)] |
| 147 | + (def test-tree b-tree) |
| 148 | + (println "Got diff" |
| 149 | + (count (remove (reduce (fn [t [op x]] |
| 150 | + (let [x-reduced (when x (mod x 1000))] |
| 151 | + (condp = op |
| 152 | + :flush t |
| 153 | + :add (conj t x-reduced) |
| 154 | + :del (disj t x-reduced)))) |
| 155 | + #{} |
| 156 | + opseq) (lookup-fwd-iter test-tree 0)))) |
| 157 | + (println "balanced?" (hitchhiker.tree.core-test/check-node-is-balanced test-tree)) |
| 158 | + (def my-root root))) |
| 159 | + |
| 160 | + (map #(and (second %) (mod (second %) 1000)) opseq) |
| 161 | + |
| 162 | + |
| 163 | + (def opseq (read-string (io/resource "redis_test_data.clj")))) |
0 commit comments