Browse files

Fixed TTL cache lookup of expired items

  • Loading branch information...
1 parent c5352fe commit 0f92a22bef16c259ab6651cc545cf5294f2e57b7 @fogus fogus committed Jul 23, 2012
Showing with 21 additions and 8 deletions.
  1. +9 −6 src/main/clojure/clojure/core/cache.clj
  2. +12 −2 src/test/clojure/clojure/core/cache/tests.clj
View
15 src/main/clojure/clojure/core/cache.clj
@@ -231,17 +231,20 @@
(defn- key-killer
- [ttl limit now]
- (let [ks (map key (filter #(> (- now (val %)) limit) ttl))]
+ [ttl expiry now]
+ (let [ks (map key (filter #(> (- now (val %)) expiry) ttl))]
#(apply dissoc % ks)))
(defcache TTLCache [cache ttl ttl-ms]
CacheProtocol
- (lookup [_ item]
- (get cache item))
- (lookup [_ item not-found]
- (get cache item not-found))
+ (lookup [this item]
+ (let [ret (lookup this item ::nope)]
+ (when-not (= ret ::nope) ret)))
+ (lookup [this item not-found]
+ (if (has? this item)
+ (get cache item)
+ not-found))
(has? [_ item]
(let [t (get ttl item (- ttl-ms))]
(< (- (System/currentTimeMillis)
View
14 src/test/clojure/clojure/core/cache/tests.clj
@@ -203,7 +203,10 @@
(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)))))
+ {:c 3} (-> C (assoc :a 1) (assoc :b 2) (sleepy 700) (assoc :c 3) .cache))))
+ (testing "TTL cache does not return a value that has expired."
+ (let [C (ttl-cache-factory {} :ttl 500)]
+ (is (nil? (-> C (assoc :a 1) (sleepy 700) (lookup :a)))))))
(deftest test-lu-cache-ilookup
(testing "that the LUCache can lookup via keywords"
@@ -242,7 +245,14 @@
(assoc :c 4)
(assoc :d 5)
(assoc :e 6))
- {:e 6, :d 5, :b 3}))))
+ {:e 6, :d 5, :b 3}))
+
+ (is (= {:a 1 :b 3}
+ (-> (clojure.core.cache/lu-cache-factory {} :threshold 2)
+ (assoc :a 1)
+ (assoc :b 2)
+ (assoc :b 3)
+ .cache)))))
;; # LIRS

0 comments on commit 0f92a22

Please sign in to comment.