Permalink
Browse files

Added tests around mapiness of TTL and LRU caches. Changed :limit kwa…

…rg on ctor fns to new name :threshold
  • Loading branch information...
1 parent 6bc1d26 commit cc0aeaf90750d9716ce20042282673727da20988 @fogus fogus committed Jun 15, 2012
Showing with 54 additions and 28 deletions.
  1. +27 −16 src/main/clojure/clojure/core/cache.clj
  2. +27 −12 src/test/clojure/clojure/core/cache/tests.clj
@@ -234,7 +234,7 @@
(lookup [_ item not-found]
(get cache item not-found))
(has? [_ item]
- (when-let [t (get ttl item)]
+ (let [t (get ttl item (- limit))]
(< (- (System/currentTimeMillis)
t)
limit)))
@@ -473,44 +473,55 @@
eventual eviction order. Otherwise, there are no guarantees for the eventual
eviction ordering.
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the FIFO semantics apply (default is 32).
+
If the number of elements in `base` is greater than the limit then some items
in `base` will be dropped from the resulting cache. If the associative
structure used as `base` can guarantee sorting, then the last `limit` elements
will be used as the cache seed values. Otherwise, there are no guarantees about
the elements in the resulting cache."
- [base & {limit :limit :or {limit 32}}]
- {:pre [(number? limit) (< 0 limit)
+ [base & {threshold :threshold :or {threshold 32}}]
+ {:pre [(number? threshold) (< 0 threshold)
(map? base)]
- :post [(== limit (count (.q %)))]}
- (clojure.core.cache/seed (FIFOCache. {} clojure.lang.PersistentQueue/EMPTY limit) base))
+ :post [(== threshold (count (.q %)))]}
+ (clojure.core.cache/seed (FIFOCache. {} clojure.lang.PersistentQueue/EMPTY threshold) base))
(defn lru-cache-factory
"Returns an LRU cache with the cache and usage-table initialied to `base` --
- each entry is initialized with the same usage value. (maybe this should be
- randomized?)"
- [base & {limit :limit :or {limit 32}}]
- {:pre [(number? limit) (< 0 limit)
+ each entry is initialized with the same usage value.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the LRU semantics apply (default is 32)."
+ [base & {threshold :threshold :or {threshold 32}}]
+ {:pre [(number? threshold) (< 0 threshold)
(map? base)]}
- (clojure.core.cache/seed (LRUCache. {} {} 0 limit) base))
+ (clojure.core.cache/seed (LRUCache. {} {} 0 threshold) base))
(defn ttl-cache-factory
"Returns a TTL cache with the cache and expiration-table initialied to `base` --
- each with the same time-to-live."
+ each with the same time-to-live.
+
+ This function also allows an optional `:ttl` argument that defines the default
+ time in milliseconds that entries are allowed to reside in the cache."
[base & {ttl :ttl :or {ttl 2000}}]
{:pre [(number? ttl) (<= 0 ttl)
(map? base)]}
(clojure.core.cache/seed (TTLCache. {} {} ttl) base))
(defn lu-cache-factory
- "Returns an LU cache with the cache and usage-table initialied to `base`."
- [base & {limit :limit :or {limit 32}}]
- {:pre [(number? limit) (< 0 limit)
+ "Returns an LU cache with the cache and usage-table initialied to `base`.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the LU semantics apply (default is 32)."
+ [base & {threshold :threshold :or {threshold 32}}]
+ {:pre [(number? threshold) (< 0 threshold)
(map? base)]}
- (clojure.core.cache/seed (LUCache. {} {} limit) base))
+ (clojure.core.cache/seed (LUCache. {} {} threshold) base))
(defn lirs-cache-factory
"Returns an LIRS cache with the S & R LRU lists set to the indicated
- limts."
+ limits."
[base & {:keys [s-history-limit q-history-limit]
:or {s-history-limit 32
q-history-limit 32}}]
@@ -129,31 +129,46 @@
(do-dot-lookup-tests (LRUCache. small-map {} 0 2)))
(testing "assoc and dissoc for LRUCache"
(do-assoc (LRUCache. {} {} 0 2))
- (do-dissoc (LRUCache. {:a 1 :b 2} {} 0 2))))
+ (do-dissoc (LRUCache. {:a 1 :b 2} {} 0 2)))
+ (testing "that get and cascading gets work for LRUCache"
+ (do-getting (LRUCache. big-map {} 0 2)))
+ (testing "that finding works for LRUCache"
+ (do-finding (LRUCache. small-map {} 0 2)))
+ (testing "that contains? works for LRUCache"
+ (do-contains (LRUCache. small-map {} 0 2))))
(deftest test-lru-cache
(testing "LRU-ness with empty cache"
- (let [C (lru-cache-factory {} :limit 2)]
+ (let [C (lru-cache-factory {} :threshold 2)]
(are [x y] (= x y)
{:a 1, :b 2} (-> C (assoc :a 1) (assoc :b 2) .cache)
{:b 2, :c 3} (-> C (assoc :a 1) (assoc :b 2) (assoc :c 3) .cache)
{:a 1, :c 3} (-> C (assoc :a 1) (assoc :b 2) (.hit :a) (assoc :c 3) .cache))))
(testing "LRU-ness with seeded cache"
- (let [C (lru-cache-factory {:a 1, :b 2} :limit 4)]
+ (let [C (lru-cache-factory {:a 1, :b 2} :threshold 4)]
(are [x y] (= x y)
{:a 1, :b 2, :c 3, :d 4} (-> C (assoc :c 3) (assoc :d 4) .cache)
{:a 1, :c 3, :d 4, :e 5} (-> C (assoc :c 3) (assoc :d 4) (.hit :c) (.hit :a) (assoc :e 5) .cache)))))
(defn sleepy [e t] (Thread/sleep t) e)
(deftest test-ttl-cache-ilookup
- (testing "that the TTLCache can lookup via keywords"
- (do-ilookup-tests (TTLCache. small-map {} 2)))
- (testing "that the TTLCache can lookup via keywords"
- (do-dot-lookup-tests (TTLCache. small-map {} 2)))
- (testing "assoc and dissoc for LRUCache"
- (do-assoc (TTLCache. {} {} 2))
- (do-dissoc (TTLCache. {:a 1 :b 2} {} 2))))
+ (let [five-secs (+ 5000 (System/currentTimeMillis))
+ big-time (into {} (for [[k _] big-map] [k five-secs]))
+ small-time (into {} (for [[k _] small-map] [k five-secs]))]
+ (testing "that the TTLCache can lookup via keywords"
+ (do-ilookup-tests (TTLCache. small-map small-time 2000)))
+ (testing "that the TTLCache can lookup via keywords"
+ (do-dot-lookup-tests (TTLCache. small-map small-time 2000)))
+ (testing "assoc and dissoc for TTLCache"
+ (do-assoc (TTLCache. {} {} 2000))
+ (do-dissoc (TTLCache. {:a 1 :b 2} {:a five-secs :b five-secs} 2000)))
+ (testing "that get and cascading gets work for TTLCache"
+ (do-getting (TTLCache. big-map big-time 2000)))
+ (testing "that finding works for TTLCache"
+ (do-finding (TTLCache. small-map small-time 2000)))
+ (testing "that contains? works for TTLCache"
+ (do-contains (TTLCache. small-map small-time 2000)))))
(deftest test-ttl-cache
(testing "TTL-ness with empty cache"
@@ -173,13 +188,13 @@
(deftest test-lu-cache
(testing "LU-ness with empty cache"
- (let [C (lu-cache-factory {} :limit 2)]
+ (let [C (lu-cache-factory {} :threshold 2)]
(are [x y] (= x y)
{:a 1, :b 2} (-> C (assoc :a 1) (assoc :b 2) .cache)
{:b 2, :c 3} (-> C (assoc :a 1) (assoc :b 2) (assoc :c 3) .cache)
{:b 2, :c 3} (-> C (assoc :a 1) (assoc :b 2) (.hit :b) (.hit :b) (.hit :a) (assoc :c 3) .cache))))
(testing "LU-ness with seeded cache"
- (let [C (lu-cache-factory {:a 1, :b 2} :limit 4)]
+ (let [C (lu-cache-factory {:a 1, :b 2} :threshold 4)]
(are [x y] (= x y)
{:a 1, :b 2, :c 3, :d 4} (-> C (assoc :c 3) (assoc :d 4) .cache)
{:a 1, :c 3, :d 4, :e 5} (-> C (assoc :c 3) (assoc :d 4) (.hit :a) (assoc :e 5) .cache)

0 comments on commit cc0aeaf

Please sign in to comment.