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.
  • 1 commit
  • 2 files changed
  • 0 commit comments
  • 1 contributor
View
58 src/main/clojure/clojure/core/cache.clj
@@ -8,7 +8,8 @@
(ns ^{:doc "A caching library for Clojure."
:author "Fogus"}
- clojure.core.cache)
+ clojure.core.cache
+ (:import (java.lang.ref ReferenceQueue SoftReference)))
;; # Protocols and Types
@@ -458,6 +459,54 @@
(toString [_]
(str cache \, \space lruS \, \space lruQ \, \space tick \, \space limitS \, \space limitQ)))
+(declare clear-soft-cache)
+
+(defn make-reference [v]
+ (if (nil? v)
+ (SoftReference. ::nil)
+ (SoftReference. v)))
+
+(defcache SoftCache [cache]
+ CacheProtocol
+ (lookup [_ item]
+ (when-let [r (get cache item)]
+ (if (= ::nil (.get r))
+ nil
+ (.get r))))
+ (lookup [_ item not-found]
+ (if-let [r (get cache item)]
+ (if-let [v (.get r)]
+ (if (= ::nil v)
+ nil
+ v)
+ not-found)
+ not-found))
+ (has? [_ item]
+ (and (contains? cache item)
+ (not (nil? (.get (get cache item))))))
+ (hit [this item] (clear-soft-cache cache))
+ (miss [_ item result]
+ (clear-soft-cache (assoc cache item (make-reference result))))
+ (evict [_ key]
+ (clear-soft-cache (dissoc cache key)))
+ (seed [_ base]
+ (SoftCache. (reduce (fn [r [k v]]
+ (if (instance? SoftReference v)
+ r
+ (assoc r k (make-reference v))))
+ base
+ base)))
+ Object
+ (toString [_] (str cache)))
+
+(defn clear-soft-cache [cache]
+ (SoftCache. (reduce (fn [r [k v]]
+ (if-not (.get v)
+ (dissoc r k v)
+ r))
+ cache
+ cache)))
+
;; Factories
(defn basic-cache-factory
@@ -519,3 +568,10 @@
(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."
+ [base]
+ {:pre [(map? base)]}
+ (seed (SoftCache. {}) base))
View
53 src/test/clojure/clojure/core/cache/tests.clj
@@ -11,7 +11,9 @@
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)))
(deftest test-basic-cache-lookup
(testing "that the BasicCache can lookup as expected"
@@ -314,3 +316,52 @@ 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 "assoc and dissoc for SoftCache"
+ (do-assoc (soft-cache-factory {}))
+ (do-dissoc (soft-cache-factory {:a 1 :b 2})))
+ (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 {:foo ref}
+ soft-cache (clear-soft-cache cache)]
+ (is (contains? (.cache soft-cache) :foo) (str cache))
+ (.clear ref)
+ (.enqueue ref)
+ (is (not (.get ref)))
+ (let [soft-cache (clear-soft-cache cache)]
+ (is (not (contains? (.cache soft-cache) :foo))))))
+
+(deftest test-soft-cache
+ (let [ref (atom nil)]
+ (with-redefs [make-reference (fn [v]
+ (reset! ref (SoftReference. v))
+ @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.