├── .gitignore ├── README.markdown ├── clache-test.asd ├── clache.asd ├── examples ├── memoize.lisp └── package.lisp ├── src ├── api.lisp ├── package.lisp ├── protocol.lisp ├── stores │ ├── file.lisp │ └── memory.lisp └── utils.lisp ├── tests ├── api.lisp ├── package.lisp └── utils.lisp └── version.lisp-expr /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx64fsl 3 | *.dx32fsl 4 | *.lx64fsl 5 | *.x86f 6 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | CLACHE 2 | ======== 3 | 4 | CLACHE is a general caching library for Common Lisp. 5 | 6 | Overview 7 | -------- 8 | 9 | CLACHE provides a general caching facility for Common Lisp. The API 10 | is similar with standard hash-table interface. Let me show you an 11 | overview of API. 12 | 13 | * `getcache` - Get cache from storage 14 | * `setcache` - Store cache into storage 15 | * `remcache` - Remove cache from storage 16 | * `clrcache` - Clear all cache in storage 17 | 18 | As you can see, it is easy to use. Here is an example: 19 | 20 | ;; Create a store 21 | (defparamater *store* (progn 22 | (ensure-directories-exist #p"cache/") 23 | (make-instance 'file-store :directory #p"cache/"))) 24 | 25 | ;; Store cache 26 | (setcache 1 "foo" *store*) 27 | ;;=> 1 28 | 29 | ;; Get cache 30 | (getcache 1 *store*) 31 | ;;=> 1, T 32 | 33 | ;; Get non-exited cache 34 | (getcache 42 *store*) 35 | ;;=> NIL, NIL 36 | 37 | ;; Remove cache 38 | (remcache 1 *store*) 39 | ;;=> T 40 | 41 | ;; Clear all cache 42 | (clrcache *store*) 43 | 44 | API 45 | --- 46 | 47 | ### Caches 48 | 49 | A cache is a triple of a key, a value, and an expiration time. 50 | 51 | ### Cache Keys 52 | 53 | Any object can be used as a cache key if the object can be converted 54 | into a string properly by using `cache-key-to-string`. 55 | 56 | ### Cache Values 57 | 58 | Same as cache keys, any object can be used as a cache value. However, 59 | a type of cache values can be limited by storages. So you have to be 60 | careful what storage are you using. 61 | 62 | ### Expiration Time 63 | 64 | An expiration time describes how long caches live in seconds. If an 65 | expiration time is `nil`, such caches will never be expired: 66 | persistent cache. 67 | 68 | ### Cache Existence 69 | 70 | If a cache is stored in a storage and has not yet been expired or a 71 | persitent cache, we express the cache exists in the storage. 72 | 73 | ### Storages 74 | 75 | Storage is an abstract layer of maintaining caches. You can access 76 | storages via API. 77 | 78 | ### Default Storage 79 | 80 | ### Function: `getcache` 81 | 82 | getcache key storage 83 | 84 | Retrieve a cache value from `storage` indicated by `key` and return 85 | values of the cache value and a boolean whether the cache exists in 86 | `storage`. The cache value will be `nil` if such the cache doesn't 87 | exist. For example, `(getcache "not-existed-cache")` will return `nil`, 88 | `nil`. 89 | 90 | ### Function: `setcache` 91 | 92 | setcache key value storage &optional expire 93 | 94 | Store a cache `value` into `storage` with `key` and `expire`. `expire` 95 | is an expiration time in seconds. If `expire` is `nil`, the cache will 96 | never be expired. The return value is `value` that has been stored. 97 | 98 | ### Function: `(setf getcache)` 99 | 100 | (setf getcache) value key storage &optional expire 101 | 102 | Same as `setcache`. 103 | 104 | ### Function: `remcache` 105 | 106 | remcache key storage 107 | 108 | Remove a cache from `storage` indicated by `key`. If the cache has 109 | been successfully removed, this function returns `t`, otherwise 110 | returns `nil`. 111 | 112 | ### Function: `clrcache` 113 | 114 | clrcache storage 115 | 116 | Remove all caches from `storage`. The return value is undefined. 117 | 118 | ### Macro: `with-cache` 119 | 120 | ### Annotation: `cache` 121 | 122 | Protocol 123 | -------- 124 | 125 | Supported Implementations 126 | ------------------------- 127 | 128 | * Allegro CL v8.2 129 | * SBCL v1.0.47 130 | * CMU CL v20b 131 | * Clozure CL v1.6 132 | * ECL v11.1.1 133 | * GNU CLISP v2.48 134 | 135 | ---- 136 | 137 | Copyright (C) 2011 Tomohiro Matsuyama <> 138 | -------------------------------------------------------------------------------- /clache-test.asd: -------------------------------------------------------------------------------- 1 | (defpackage clache-test-asd 2 | (:use :cl :asdf)) 3 | (in-package :clache-test-asd) 4 | 5 | (defsystem clache-test 6 | :depends-on (:clache 7 | :cl-test-more) 8 | :components ((:module "tests" 9 | :serial t 10 | :components ((:file "package") 11 | (:file "utils") 12 | (:file "api"))))) 13 | -------------------------------------------------------------------------------- /clache.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | 3 | (defpackage clache-asd 4 | (:use :cl :asdf)) 5 | (in-package :clache-asd) 6 | 7 | (defsystem :clache 8 | :version (:read-from-file "version.lisp-expr") 9 | :author "Tomohiro Matsuyama" 10 | :maintainer "Olexiy Zamkoviy" 11 | :license "LLGPL" 12 | :depends-on (:alexandria 13 | :trivial-garbage 14 | :babel 15 | :ironclad 16 | :cl-fad 17 | :cl-store 18 | :cl-annot 19 | :cl-syntax 20 | :cl-syntax-annot) 21 | :components ((:module "src" 22 | :serial t 23 | :components ((:file "package") 24 | (:file "utils") 25 | (:file "protocol") 26 | (:module "stores" 27 | :serial t 28 | :components ((:file "memory") 29 | (:file "file"))) 30 | (:file "api"))))) 31 | -------------------------------------------------------------------------------- /examples/memoize.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-cache-example) 2 | (use-syntax annot-syntax) 3 | 4 | (defun tak (x y z) 5 | (if (<= x y) 6 | z 7 | (tak (tak (1- x) y z) 8 | (tak (1- y) z x) 9 | (tak (1- z) x y)))) 10 | 11 | (defun tak/with-cache (x y z) 12 | (with-cache ((list x y z)) 13 | (if (<= x y) 14 | z 15 | (tak (tak/with-cache (1- x) y z) 16 | (tak/with-cache (1- y) z x) 17 | (tak/with-cache (1- z) x y))))) 18 | 19 | @cache ((x y z)) 20 | (defun tak/cache-annotation (x y z) 21 | (if (<= x y) 22 | z 23 | (tak (tak/cache-annotation (1- x) y z) 24 | (tak/cache-annotation (1- y) z x) 25 | (tak/cache-annotation (1- z) x y)))) 26 | 27 | #| 28 | 29 | Sample output: 30 | 31 | CL-CACHE-EXAMPLE> (time (tak 20 10 0)) 32 | (TAK 20 10 0) took 1,345,999 microseconds (1.345999 seconds) 33 | CL-CACHE-EXAMPLE> (time (tak/with-cache 20 10 0)) 34 | (TAK/WITH-CACHE 20 10 0) took 5,894 microseconds (0.005894 seconds) 35 | CL-CACHE-EXAMPLE> (time (tak/cache-annotation 20 10 0)) 36 | (TAK/CACHE-ANNOTATION 20 10 0) took 7,620 microseconds (0.007620 seconds) 37 | 38 | |# 39 | -------------------------------------------------------------------------------- /examples/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage cl-cache-example 2 | (:use :cl 3 | :cl-cache 4 | :cl-annot 5 | :cl-syntax 6 | :cl-syntax-annot)) 7 | -------------------------------------------------------------------------------- /src/api.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache) 2 | (use-syntax :annot) 3 | 4 | #| 5 | 6 | API 7 | --- 8 | 9 | ### Caches 10 | 11 | A cache is a triple of a key, a value, and an expiration time. 12 | 13 | ### Cache Keys 14 | 15 | Any object can be used as a cache key if the object can be converted 16 | into a string properly by using CACHE-KEY-TO-STRING. 17 | 18 | ### Cache Values 19 | 20 | Same as cache keys, any object can be used as a cache value. However, 21 | a type of cache values can be limited by stores. So you have to be 22 | careful what store are you using. 23 | 24 | ### Expiration Time 25 | 26 | An expiration time describes how long caches live in seconds. If an 27 | expiration time is NIL, such caches will never be expired: persistent 28 | cache. 29 | 30 | ### Cache Existence 31 | 32 | If a cache is stored in a store and has not yet been expired or a 33 | persitent cache, we express the cache exists in the store. 34 | 35 | ### Stores 36 | 37 | Store is an abstract layer of maintaining caches. You can access 38 | stores via API. 39 | 40 | |# 41 | 42 | @export 43 | (defun getcache (key store) 44 | "Retrieve a cache value from STORE indicated by KEY and return 45 | values of the cache value and a boolean whether the cache exists in 46 | STORE. The cache value will be NIL if such the cache doesn't 47 | exist. For example, (getcache \"not-existed-cache\") will return NIL, 48 | NIL." 49 | ;@type (store store) 50 | (load-cache key store)) 51 | 52 | @export 53 | (defun setcache (key value store &key expire) 54 | "Store a cache VALUE into STORE with KEY and EXPIRE. EXPIRE is an 55 | expiration time in seconds. If EXPIRE is NIL, the cache will never be 56 | expired. The return value is VALUE that has been stored." 57 | ;@type (store store) 58 | ;@type (expire expire) 59 | (store-cache key value store expire)) 60 | 61 | @export 62 | (defun (setf getcache) (value key store &key expire) 63 | ;@type (store store) 64 | ;@type (expire expire) 65 | (store-cache key value store expire)) 66 | 67 | @export 68 | (defun remcache (key store) 69 | "Remove a cache from STORE indicated by KEY. If the cache has been 70 | successfully removed, this function returns T, otherwise returns NIL." 71 | ;@type (store store) 72 | (delete-cache key store)) 73 | 74 | @export 75 | (defun clrcache (store) 76 | "Remove all caches from STORE. The return value is undefined." 77 | ;@type (store store) 78 | (clear-cache store)) 79 | 80 | @export 81 | (defmacro with-cache ((key &key store expire) &body body) 82 | "If a cache indicated by KEY exists, this just returns the cache 83 | value without evaluating BODY. Otherwise, this evaluates BODY and 84 | stores the evaluated value into STORE with KEY and EXPIRE. KEY is a 85 | form that an evaluated value indicates the cache key. 86 | 87 | Example: 88 | 89 | (defun f (x) 90 | (with-cache (x *store*) 91 | (very-complex-computation x)))" 92 | (once-only (key store expire) 93 | (with-gensyms (value exists-p) 94 | `(multiple-value-bind (,value ,exists-p) 95 | (getcache ,key ,store) 96 | (if ,exists-p 97 | ,value 98 | (let ((,value (progn ,@body))) 99 | (setcache ,key ,value ,store :expire ,expire) 100 | ,value)))))) 101 | 102 | @export 103 | (defmacro with-inline-cache ((key &key expire (test 'equal) weakness) &body body) 104 | "Same as WITH-CACHE, except that an inline memory store will be used 105 | as a cache store. TEST is a function to test hash table keys of the 106 | memory store. WEAKNESS specifies the hash table is weak-hash-table or 107 | not." 108 | (let* ((hash-table-form `(trivial-garbage:make-weak-hash-table :test (quote ,test) :weakness ,weakness)) 109 | (store-form `(make-instance 'memory-store :hash-table ,hash-table-form))) 110 | `(with-cache (,key :store (load-time-value ,store-form) :expire ,expire) 111 | ,@body))) 112 | 113 | @export 114 | @annotation (:arity 2) 115 | (defmacro cache ((keyargs &key store expire) function-definition-form) 116 | "Annotation for caching functions with their arguments. This should 117 | be used with CL-ANNOT. KEYARGS is a form or a list of form for making 118 | a cache key. To make cache keys distinct as to the function, you may 119 | add a keyword or a symbol into KEYARGS. See also WITH-CACHE. 120 | 121 | Example: 122 | 123 | @cache ((:f x y z)) 124 | (defun f (x y z) 125 | ...) 126 | 127 | ;; Remove a cache of F 128 | (remcache '(:f 1 2 3))" 129 | (replace-function-body 130 | (lambda (name lambda-list body) 131 | @ignore name 132 | @ignore lambda-list 133 | (let ((key (if (listp keyargs) 134 | `(list ,@keyargs) 135 | keyargs))) 136 | `(with-cache (,key :store ,store :expire ,expire) 137 | ,@body))) 138 | function-definition-form)) 139 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | 3 | (defpackage :clache 4 | (:use :cl) 5 | (:import-from :alexandria 6 | #:once-only 7 | #:with-gensyms) 8 | (:import-from :annot 9 | #:annotation) 10 | (:import-from :annot.util 11 | #:replace-function-body) 12 | (:import-from :syntax 13 | #:use-syntax)) 14 | -------------------------------------------------------------------------------- /src/protocol.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache) 2 | (use-syntax :annot) 3 | 4 | #| 5 | 6 | Protocol 7 | -------- 8 | 9 | TODO 10 | 11 | |# 12 | 13 | @export 14 | (defclass store () 15 | () 16 | (:documentation "An abstract class of stores. All stores must 17 | inherit from this class.")) 18 | 19 | (deftype expire () 20 | "Type for expiration time." 21 | '(or null integer)) 22 | 23 | @export 24 | (defgeneric load-cache (key store) 25 | (:documentation "Try to retrieve a cache indicated by KEY from STORE 26 | and return values of the cache value and a boolean whether the cache 27 | exists in STORE. The cache value should be NIL if such the cache 28 | doesn't exist or has been expired.")) 29 | 30 | @export 31 | (defgeneric store-cache (key value store expire) 32 | (:documentation "Store a cache VALUE with KEY into STORE. EXPIRE is 33 | a keep time in seconds. If EXPIRE is NIL, the cache will never 34 | expired. This function should return the value that has been 35 | stored.")) 36 | 37 | @export 38 | (defgeneric delete-cache (key store) 39 | (:documentation "Remove a cache indicated by KEY from STORE. If the 40 | cache has been successfully removed, this function should return T, 41 | otherwise should return NIL.")) 42 | 43 | @export 44 | (defgeneric clear-cache (store) 45 | (:documentation "Remove all caches from STORE. Any object can be 46 | returned.")) 47 | 48 | @export 49 | (defgeneric cache-key-to-string (key) 50 | (:documentation "This function converts any type of KEY into 51 | string. This should be an injective function, meaning this should not 52 | lose the information about key.") 53 | (:method (key) (object-to-string key))) 54 | 55 | @export 56 | (defun never-expire-p (expire) 57 | "Return T if EXPIRE represents caches will never be expired." 58 | (eq expire nil)) 59 | -------------------------------------------------------------------------------- /src/stores/file.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache) 2 | (use-syntax :annot) 3 | 4 | #| 5 | 6 | File Store 7 | ---------- 8 | 9 | TODO 10 | 11 | |# 12 | 13 | @export 14 | (defclass file-store (store) 15 | (@annot.slot:required 16 | (directory :reader directory-of))) 17 | 18 | (defun cache-path (key store) 19 | (merge-pathnames (md5-hex-string (cache-key-to-string key)) 20 | (directory-of store))) 21 | 22 | (defmethod load-cache (key (store file-store)) 23 | (let ((path (cache-path key store))) 24 | (if (probe-file path) 25 | (let* ((cell (cl-store:restore path)) 26 | (expire (car cell)) 27 | (value (cdr cell))) 28 | (if (and (not (never-expire-p expire)) 29 | (<= expire (get-universal-time))) 30 | (values nil nil) 31 | (values value t))) 32 | (values nil nil)))) 33 | 34 | (defmethod store-cache (key value (store file-store) expire) 35 | (when expire 36 | (setf expire (+ (get-universal-time) expire))) 37 | (cl-store:store (cons expire value) 38 | (cache-path key store)) 39 | value) 40 | 41 | (defmethod delete-cache (key (store file-store)) 42 | (let ((path (cache-path key store))) 43 | (when (probe-file path) 44 | (delete-file path)))) 45 | 46 | (defmethod clear-cache ((store file-store)) 47 | (dolist (file (fad:list-directory (directory-of store))) 48 | (delete-file file))) 49 | -------------------------------------------------------------------------------- /src/stores/memory.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache) 2 | (use-syntax :annot) 3 | 4 | #| 5 | 6 | File Store 7 | ---------- 8 | 9 | TODO 10 | 11 | |# 12 | 13 | @export 14 | (defclass memory-store (store) 15 | ((hash-table :initform (make-hash-table :test #'equal) 16 | :initarg :hash-table 17 | :reader hash-table-of))) 18 | 19 | (defmethod load-cache (key (store memory-store)) 20 | (let ((cell (gethash key (hash-table-of store)))) 21 | (if cell 22 | (let ((expire (car cell)) 23 | (value (cdr cell))) 24 | (if (and (not (never-expire-p expire)) 25 | (<= expire (get-universal-time))) 26 | (values nil nil) 27 | (values value t))) 28 | (values nil nil)))) 29 | 30 | (defmethod store-cache (key value (store memory-store) expire) 31 | (when expire 32 | (setf expire (+ (get-universal-time) expire))) 33 | (setf (gethash key (hash-table-of store)) 34 | (cons expire value)) 35 | value) 36 | 37 | (defmethod delete-cache (key (store memory-store)) 38 | (remhash key (hash-table-of store))) 39 | 40 | (defmethod clear-cache ((store memory-store)) 41 | (clrhash (hash-table-of store))) 42 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache) 2 | (use-syntax :annot) 3 | 4 | (defun symbol-fqn (symbol) 5 | "Return a fully qualified name of SYMBOL in string. For 6 | example, (symbol-fqn 'if) will return \"COMMON-LISP:IF\"." 7 | (declare (symbol symbol)) 8 | (format nil "~A:~A" 9 | (package-name (symbol-package symbol)) 10 | (symbol-name symbol))) 11 | 12 | (defun object-to-string (object) 13 | "Convert OBJECT into string by using PRINC-TO-STRING if OBJECT is 14 | not a symbol, or by using SYMBOL-FQN if OBJECT is a symbol." 15 | (if (symbolp object) 16 | (symbol-fqn object) 17 | (princ-to-string object))) 18 | 19 | (defun md5-hex-string (string) 20 | "Return a MD5 digest of STRING in hex string." 21 | (let* ((octets (babel:string-to-octets string)) 22 | (digest (ironclad:digest-sequence 'ironclad:md5 octets)) 23 | (hex-string (format nil "~{~2,'0X~}" (coerce digest 'list)))) 24 | (string-downcase hex-string))) 25 | -------------------------------------------------------------------------------- /tests/api.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache-test) 2 | 3 | (defun test-storage-via-api (storage) 4 | (format t "Running ~A test suite~%" (type-of storage)) 5 | (let ((*default-storage* storage)) 6 | ;; Basic tests 7 | 8 | (clrcache storage) 9 | 10 | (is (multiple-value-list (getcache "none" storage)) 11 | '(nil nil) 12 | "Getting non-existed cache should return nil, nil") 13 | 14 | (is (setcache "foo" 1 storage) 15 | 1 16 | "Setting cache should return its value") 17 | 18 | (is (multiple-value-list (getcache "foo" storage)) 19 | '(1 t) 20 | "Getting cache that has been set should return value, t") 21 | 22 | (is (setf (getcache "bar" storage) 2) 23 | 2 24 | "Setting cache by setf should also return its value") 25 | 26 | (is (multiple-value-list (getcache "bar" storage)) 27 | '(2 t) 28 | "Getting cache that has been set by setf should also return value, t") 29 | 30 | (is (setcache "bar" 3 storage) 31 | 3 32 | "Overwriting cache should return its value") 33 | 34 | (is (multiple-value-list (getcache "bar" storage)) 35 | '(3 t) 36 | "Getting cache that has been overwrote should return value, t") 37 | 38 | (is (remcache "none" storage) 39 | nil 40 | "Removing non-existed cache should return nil") 41 | 42 | (is (remcache "foo" storage) 43 | t 44 | "Removing existed cache should return t") 45 | 46 | (is (multiple-value-list (getcache "foo" storage)) 47 | '(nil nil) 48 | "Getting removed cache should return nil, nil") 49 | 50 | (clrcache storage) 51 | 52 | (is (multiple-value-list (getcache "bar" storage)) 53 | '(nil nil) 54 | "Getting cleared (removed) cache should return nil, nil") 55 | 56 | (is (with-cache ("foo" :store storage) 1) 57 | 1 58 | "with-cache with non-existed cache should evalute its body") 59 | 60 | (is (with-cache ("foo" :store storage) (error "MUST NOT BE ERROR")) 61 | 1 62 | "with-cache with existed cache shouldn't evalute its body") 63 | 64 | (is-error (with-cache ("none" :store storage) (error "SHOULD BE ERROR")) 65 | error 66 | "with-cache with non-existed cache should evalute its body even if it reports an error") 67 | 68 | (is (multiple-value-list (getcache "none" storage)) 69 | '(nil nil) 70 | "Getting non-existed cache that hasn't set by with-cache because of evaluation errors should return nil, nil") 71 | 72 | ;; Expiration tests 73 | 74 | (clrcache storage) 75 | 76 | (is (setcache "foo" 1 storage :expire 2) 77 | 1 78 | "Setting cache with expiration time should return its value") 79 | 80 | (sleep 0.5) 81 | 82 | (is (multiple-value-list (getcache "foo" storage)) 83 | '(1 t) 84 | "Getting existed cache that hasn't yet been expired should return value, t") 85 | 86 | (sleep 2) 87 | 88 | (is (multiple-value-list (getcache "foo" storage)) 89 | '(nil nil) 90 | "Getting existed cache that has already been expired should return nil, nil") 91 | 92 | (is (setf (getcache "foo" storage) 1) 93 | 1 94 | "Setting cache by setf with expiration time should return its value") 95 | 96 | (sleep 0.5) 97 | 98 | (is (multiple-value-list (getcache "foo" storage)) 99 | '(1 t) 100 | "Getting existed cache that has been set by setf and hasn't yet been expired should return value, t") 101 | 102 | (sleep 2) 103 | 104 | (is (multiple-value-list (getcache "foo" storage)) 105 | '(nil nil) 106 | "Getting existed cache that has been set by setf and has been expired should return nil, nil") 107 | 108 | (setcache "bar" 1 storage) 109 | 110 | (is (setcache "bar" 2 storage :expire 2) 111 | 2 112 | "Overwriting never-expire cache with expiration time should return its value") 113 | 114 | (sleep 0.5) 115 | 116 | (is (multiple-value-list (getcache "bar" storage)) 117 | '(2 t) 118 | "Getting existed cache that has been overwrote with expiration time and hasn't yet been expired should return value, t") 119 | 120 | (sleep 2) 121 | 122 | (is (multiple-value-list (getcache "bar" storage)) 123 | '(nil nil) 124 | "Getting existed cache that has been overwrote with expiration time and has been expired should return nil, nil") 125 | 126 | (setcache "bar" 2 storage :expire 2) 127 | 128 | (is (setcache "bar" 3 storage) 129 | 3 130 | "Overwriting will-expire cache with never-expiration time should return its value") 131 | 132 | (sleep 3) 133 | 134 | (is (multiple-value-list (getcache "bar" storage)) 135 | '(3 t) 136 | "Getting existed cache that has been overwrote with never-expiration time and has been expired should return value, t") 137 | 138 | (is (with-cache ("foo" :expire 2 :store storage) 1) 139 | 1 140 | "with-cache with non-existed cache and expiration-time should evalute its body") 141 | 142 | (sleep 0.5) 143 | 144 | (is (with-cache ("foo" :expire 2 :store storage) (error "MUST NOT BE ERROR")) 145 | 1 146 | "with-cache with existed cache that hasn't yet been expired doesn't evalute its body should return value") 147 | 148 | (sleep 2) 149 | 150 | (is (with-cache ("foo" :expire 2 :store storage) 2) 151 | 2 152 | "with-cache with existed cache that has been expired evalutes its body should return value") 153 | 154 | (is-error (with-cache ("none" :expire 2 :store storage) (error "SHOULD BE ERROR")) 155 | error 156 | "with-cache with non-existed cache and expiration-time should evalute its body even if it reports an error") 157 | 158 | ;; TODO key tests 159 | ;; TODO CLOS tests 160 | 161 | ;; Cleanup 162 | (clrcache storage))) 163 | 164 | (defun test-all-storages-via-api () 165 | (let ((cache-dir #p"/tmp/clache-test/")) 166 | (ensure-directories-exist cache-dir) 167 | (dolist (storage (list (make-instance 'memory-store) 168 | (make-instance 'file-store 169 | :directory cache-dir))) 170 | (test-storage-via-api storage)))) 171 | 172 | (test-all-storages-via-api) 173 | -------------------------------------------------------------------------------- /tests/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage clache-test 2 | (:use :cl 3 | :cl-test-more) 4 | (:import-from :clache 5 | :symbol-fqn 6 | :object-to-string 7 | :md5-hex-string 8 | :getcache 9 | :setcache 10 | :remcache 11 | :clrcache 12 | :with-cache 13 | :cache 14 | :memory-store 15 | :file-store)) 16 | -------------------------------------------------------------------------------- /tests/utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :clache-test) 2 | 3 | (is (symbol-fqn 'foo) 4 | "CLACHE-TEST:FOO" 5 | "symbol-fqn") 6 | 7 | (is (object-to-string 'foo) 8 | "CLACHE-TEST:FOO" 9 | "object-to-string for symbol") 10 | 11 | (is (object-to-string 123) 12 | "123" 13 | "object-to-string for otherwise") 14 | 15 | (is (md5-hex-string "foo") 16 | "acbd18db4cc2f85cedef654fccc4a4d8" 17 | "md5-hex-string") 18 | -------------------------------------------------------------------------------- /version.lisp-expr: -------------------------------------------------------------------------------- 1 | "0.2.1" 2 | --------------------------------------------------------------------------------