Permalink
Browse files

CCACHE-21: Adding seed data to LRU and LU caches to avoid cache data …

…retention.
  • Loading branch information...
1 parent d43678d commit 5751b7e8d8d2f10c87b8a79c8ed9b0324368514d @fogus fogus committed Mar 14, 2012
Showing with 33 additions and 5 deletions.
  1. +9 −4 src/main/clojure/clojure/core/cache.clj
  2. +24 −1 src/test/clojure/clojure/core/cache/tests.clj
@@ -176,6 +176,11 @@
(toString [_]
(str cache \, \space (pr-str q))))
+(defn- build-leastness-queue
+ [base limit start-at]
+ (merge
+ (into {} (take (- limit (count base)) (for [k (range (- limit) 0)] [k k])))
+ (into {} (for [[k _] base] [k start-at]))))
(defcache LRUCache [cache lru tick limit]
CacheProtocol
@@ -193,8 +198,8 @@
limit)))
(miss [_ item result]
(let [tick+ (inc tick)]
- (if (>= (count cache) limit)
- (let [k (apply min-key lru (keys lru))]
+ (if-let [ks (keys lru)]
+ (let [k (apply min-key lru ks)]
(LRUCache. (-> cache (dissoc k) (assoc item result)) ;; eviction case
(-> lru (dissoc k) (assoc item tick+))
tick+
@@ -213,7 +218,7 @@
limit))))
(seed [_ base]
(LRUCache. base
- (into {} (for [k (keys base)] [k 0]))
+ (build-leastness-queue base limit 0)
0
limit))
Object
@@ -289,7 +294,7 @@
limit))))
(seed [_ base]
(LUCache. base
- (into {} (for [x (range (- limit) 0)] [x x]))
+ (build-leastness-queue base limit 0)
limit))
Object
(toString [_]
@@ -142,7 +142,9 @@
(let [C (lru-cache-factory {:a 1, :b 2} :limit 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)))))
+ {: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"
@@ -153,6 +155,13 @@
(do-assoc (TTLCache. {} {} 2))
(do-dissoc (TTLCache. {:a 1 :b 2} {} 2))))
+(deftest test-ttl-cache
+ (testing "TTL-ness with empty cache"
+ (let [C (ttl-cache-factory {} :ttl 500)]
+ (are [x y] (= x y)
+ {:a 1, :b 2} (-> C (assoc :a 1) (assoc :b 2) .cache)
+ {:c 3} (-> C (assoc :a 1) (assoc :b 2) (sleepy 700) (assoc :c 3) .cache)))))
+
(deftest test-lu-cache-ilookup
(testing "that the LUCache can lookup via keywords"
(do-ilookup-tests (LUCache. small-map {} 2)))
@@ -162,6 +171,20 @@
(do-assoc (LUCache. {} {} 2))
(do-dissoc (LUCache. {:a 1 :b 2} {} 2))))
+(deftest test-lu-cache
+ (testing "LU-ness with empty cache"
+ (let [C (lu-cache-factory {} :limit 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)]
+ (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)
+ {:b 2, :c 3, :d 4, :e 5} (-> C (assoc :c 3) (assoc :d 4) (.hit :b) (.hit :c) (.hit :d) (assoc :e 5) .cache)))))
+
;; # LIRS
(defn- lirs-map [lirs]

0 comments on commit 5751b7e

Please sign in to comment.