Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
Checking mergeability… Don’t worry, you can still create the pull request.
  • 2 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
View
81 src/main/clojure/clojure/core/cache.clj
@@ -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))
View
57 src/test/clojure/clojure/core/cache/tests.clj
@@ -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.