Never let test / key be nil

re ADWolf:#1358
AccelerationNet · Nov 30, 2015 · 8a8259e · 8a8259e
1 parent 2d30d66
commit 8a8259e
Showing 1 changed file with 23 additions and 20 deletions.
diff --git a/access.lisp b/access.lisp
@@ -91,12 +91,15 @@
 (defvar *default-test* #'access:equalper)
 (defvar *default-key* #'identity)
 
+(defun default-test () (or *default-test* #'access:equalper))
+(defun default-key () (or *default-key* #'identity))
+
 (defgeneric plist-val (id list &key test key)
   (:documentation "get a value out of a plist based on its key")
-  (:method (id list &key (test *default-test*) (key *default-key*))
+  (:method (id list &key (test (default-test)) (key (default-key)))
     (iter (for (k v) on list by #'cddr)
-      (for found = (funcall (or test *default-test*)
-                            (funcall (or key *default-key*) k)
+      (for found = (funcall (or test (default-test))
+                            (funcall (or key (default-key)) k)
                             id))
       (when found
           (return-from plist-val (values v found))))))
@@ -105,31 +108,31 @@
   (:documentation
    "removes key & its value from plist returning
    (values plist (list-of-values-removed))")
-  (:method (id list &key (test *default-test*) (key *default-key*))
+  (:method (id list &key (test (default-test)) (key (default-key)))
     (iter
       (for (k v) on list by #'cddr)
-      (cond ((funcall (or test *default-test*)
-                      (funcall (or key *default-key*) k)
+      (cond ((funcall (or test (default-test))
+                      (funcall (or key (default-key)) k)
                       id)
              (collect v into removed))
             (T (collect k into plist)
                (collect v into plist)))
       (finally (return (values plist removed))))))
 
-(defmacro rem-plist-val! (id place &key (test '*default-test*) (key '*default-key*))
+(defmacro rem-plist-val! (id place &key (test '(default-test)) (key '(default-key)))
   `(setf ,place
     (rem-plist-val ,id ,place :test ,test :key ,key)))
 
 (defgeneric set-plist-val (new id list &key test key)
   (:documentation "If a key exists in the plist, set its value, otherwise add
   this key to the dictionary")
-  (:method (new id list &key (test *default-test*) (key *default-key*))
+  (:method (new id list &key (test (default-test)) (key (default-key)))
     (iter
       (with collected)
       (for (k v) on list by #'cddr)
       (collect k into res)
-      (if (funcall (or test *default-test*)
-                   (funcall (or key *default-key*) k)
+      (if (funcall (or test (default-test))
+                   (funcall (or key (default-key)) k)
                    id)
           (progn (setf collected T)
                  (collect new into res))
@@ -140,7 +143,7 @@
        (return res)))))
 
 (defmacro set-plist-val! (new id place
-                          &key (test '*default-test*) (key '*default-key*))
+                          &key (test '(default-test)) (key '(default-key)))
   `(setf ,place
     (set-plist-val ,new ,id ,place :test ,test :key ,key)))
 
@@ -251,10 +254,10 @@
    #'closer-mop:slot-definition-name
    (access:class-slots o)))
 
-(defun class-slot-by-name (o k &key (test *default-test*) )
+(defun class-slot-by-name (o k &key (test (default-test)) )
   (iter (for s in (access:class-slots o))
     (for name = (ensure-slot-name s))
-    (when (funcall (or test *default-test*)
+    (when (funcall (or test (default-test))
                    k name)
       (return (values s name)))))
 
@@ -392,14 +395,14 @@
   o)
 
 (defgeneric do-access  (o k &key test key type skip-call?)
-  (:method ((o list) k &key (test *default-test*) (key *default-key*)
+  (:method ((o list) k &key (test (default-test)) (key (default-key))
                        type skip-call?)
     (declare (ignore skip-call?))
     (if (or (eql type :alist)
             (and (null type) (consp (first o))))
         ;;alist
-        (let ((assoc (assoc k o :test (or test *default-test*)
-                                :key (or key *default-key*))))
+        (let ((assoc (assoc k o :test (or test (default-test))
+                                :key (or key (default-key)))))
           (values (cdr assoc) (and assoc t)))
         ;;plist
         (plist-val k o :test test :key key)))
@@ -417,7 +420,7 @@
           (awhen (ignore-errors (string k))
             (gethash it o)))))
 
-  (:method (o  k &key (test *default-test*) (key *default-key*)
+  (:method (o  k &key (test (default-test)) (key (default-key))
                  type skip-call?)
     ;; not specializing on standard-object here
     ;; allows this same code path to work with conditions (in sbcl)
@@ -431,11 +434,11 @@
         ;; lets recheck for an accessor in the correct package
         (actual-slot-name
          (access o actual-slot-name
-                 :test (or test *default-test*)
-                 :key (or key *default-key*)
+                 :test (or test (default-test))
+                 :key (or key (default-key))
                  :type type :skip-call? skip-call?))))))
 
-(defun access (o k &key type (test *default-test*) (key *default-key*)
+(defun access (o k &key type (test (default-test)) (key (default-key))
                    skip-call?)
   "Access plists, alists, arrays, hashtables and clos objects
    all through the same interface