Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 2 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
81 src/main/clojure/clojure/core/cache.clj
View
@@ -8,7 +8,9 @@
(ns ^{:doc "A caching library for Clojure."
:author "Fogus"}
- clojure.core.cache)
+ clojure.core.cache
+ (:import (java.lang.ref ReferenceQueue SoftReference)
+ (java.util.concurrent ConcurrentHashMap)))
;; # Protocols and Types
@@ -458,6 +460,72 @@
(toString [_]
(str cache \, \space lruS \, \space lruQ \, \space tick \, \space limitS \, \space limitQ)))
+(defn clear-soft-cache! [cache rcache rq]
+ (loop [r (.poll rq)]
+ (when r
+ (.remove cache (get rcache r))
+ (.remove rcache r)
+ (recur (.poll rq)))))
+
+(defn make-reference [v rq]
+ (if (nil? v)
+ (SoftReference. ::nil rq)
+ (SoftReference. v rq)))
+
+(defcache SoftCache [cache rcache rq]
+ CacheProtocol
+ (lookup [_ item]
+ (when-let [r (get cache (or item ::nil))]
+ (if (= ::nil (.get r))
+ nil
+ (.get r))))
+ (lookup [_ item not-found]
+ (if-let [r (get cache (or item ::nil))]
+ (if-let [v (.get r)]
+ (if (= ::nil v)
+ nil
+ v)
+ not-found)
+ not-found))
+ (has? [_ item]
+ (let [item (or item ::nil)]
+ (and (contains? cache item)
+ (not (nil? (.get (get cache item)))))))
+ (hit [this item]
+ (clear-soft-cache! cache rcache rq)
+ this)
+ (miss [this item result]
+ (let [item (or item ::nil)
+ r (make-reference result rq)]
+ (.put cache item r)
+ (.put rcache r item)
+ (clear-soft-cache! cache rcache rq)
+ this))
+ (evict [this key]
+ (let [key (or key ::nil)
+ r (get cache key)]
+ (when r
+ (.remove cache key)
+ (.remove rcache r))
+ (clear-soft-cache! cache rcache rq)
+ this))
+ (seed [_ base]
+ (let [soft-cache? (instance? SoftCache base)
+ cache (ConcurrentHashMap.)
+ rcache (ConcurrentHashMap.)
+ rq (ReferenceQueue.)]
+ (if (seq base)
+ (doseq [[k v] base]
+ (let [k (or k ::nil)
+ r (if soft-cache?
+ (make-reference (.get v) rq)
+ (make-reference v rq))]
+ (.put cache k r)
+ (.put rcache r k))))
+ (SoftCache. cache rcache rq)))
+ Object
+ (toString [_] (str cache)))
+
;; Factories
(defn basic-cache-factory
@@ -519,3 +587,14 @@
(map? base)]}
(seed (LIRSCache. {} {} {} 0 s-history-limit q-history-limit) base))
+(defn soft-cache-factory
+ "Returns a SoftReference cache. Cached values will be referred to with
+ SoftReferences, allowing the values to be garbage collected when there is
+ memory pressure on the JVM.
+
+ SoftCache is a mutable cache, since it is always based on a
+ ConcurrentHashMap."
+ [base]
+ {:pre [(map? base)]}
+ (seed (SoftCache. (ConcurrentHashMap.) (ConcurrentHashMap.) (ReferenceQueue.))
+ base))
57 src/test/clojure/clojure/core/cache/tests.clj
View
@@ -11,7 +11,10 @@
clojure.core.cache.tests
(:use [clojure.core.cache] :reload-all)
(:use [clojure.test])
- (:import [clojure.core.cache BasicCache FIFOCache LRUCache TTLCache LUCache LIRSCache]))
+ (:import (clojure.core.cache BasicCache FIFOCache LRUCache TTLCache LUCache
+ LIRSCache)
+ (java.lang.ref ReferenceQueue SoftReference)
+ (java.util.concurrent ConcurrentHashMap)))
(deftest test-basic-cache-lookup
(testing "that the BasicCache can lookup as expected"
@@ -314,3 +317,55 @@ N non-resident HIR block
:lruQ {:8 14 :9 13}
:tick 14 :limitS 3 :limitQ 2}))))))
+(deftest test-soft-cache-ilookup
+ (testing "counts"
+ (is (= 0 (count (soft-cache-factory {}))))
+ (is (= 1 (count (soft-cache-factory {:a 1})))))
+ (testing "that the SoftCache can lookup via keywords"
+ (do-ilookup-tests (soft-cache-factory small-map)))
+ (testing "that the SoftCache can .lookup"
+ (do-dot-lookup-tests (soft-cache-factory small-map)))
+ (testing "that get and cascading gets work for SoftCache"
+ (do-getting (soft-cache-factory big-map)))
+ (testing "that finding works for SoftCache"
+ (do-finding (soft-cache-factory small-map)))
+ (testing "that contains? works for SoftCache"
+ (do-contains (soft-cache-factory small-map))))
+
+(deftest test-clear-soft-cache!
+ (let [rq (ReferenceQueue.)
+ ref (SoftReference. :bar rq)
+ cache (doto (ConcurrentHashMap.)
+ (.put :foo ref))
+ rcache (doto (ConcurrentHashMap.)
+ (.put ref :foo))
+ soft-cache (clear-soft-cache! cache rcache rq)]
+ (is (contains? cache :foo) (str cache))
+ (is (contains? rcache ref) (str rcache))
+ (.clear ref)
+ (.enqueue ref)
+ (is (not (.get ref)))
+ (let [soft-cache (clear-soft-cache! cache rcache rq)]
+ (is (not (contains? cache :foo)))
+ (is (not (contains? rcache ref))))))
+
+(deftest test-soft-cache
+ (let [ref (atom nil)
+ old-make-reference make-reference]
+ (with-redefs [make-reference (fn [& args]
+ (reset! ref (apply old-make-reference args))
+ @ref)]
+ (let [old-soft-cache (soft-cache-factory {:foo1 :bar})
+ r @ref
+ soft-cache (assoc old-soft-cache :foo2 :baz)]
+ (is (and r (= :bar (.get r))))
+ (.clear r)
+ (.enqueue r)
+ (is (nil? (.lookup soft-cache :foo1)))
+ (is (nil? (.lookup old-soft-cache :foo1)))
+ (is (= :quux (.lookup soft-cache :foo1 :quux)))
+ (is (= :quux (.lookup old-soft-cache :foo1 :quux)))
+ (is (= :quux (.lookup soft-cache :foo3 :quux)))
+ (is (= :quux (.lookup old-soft-cache :foo3 :quux)))
+ (is (not (.has? soft-cache :foo1)))
+ (is (not (.has? old-soft-cache :foo1)))))))

No commit comments for this range

Something went wrong with that request. Please try again.