changeset 5336:287499ff4c5f

Pass in the DEFAULT argument to position() as documented, #'find. src/ChangeLog addition: 2011-01-14 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Ffind): Use the correct subr information here, pass in the DEFAULT keyword argument value correctly. tests/ChangeLog addition: 2011-01-14 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (list): Test #'find, especially the :default keyword, not specified by Common Lisp.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 14 Jan 2011 23:16:25 +0000
parents c9d31263ab7d
children 906ccc7dcd70
files src/ChangeLog src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
diffstat 4 files changed, 38 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Tue Jan 11 13:39:35 2011 +0000
+++ b/src/ChangeLog	Fri Jan 14 23:16:25 2011 +0000
@@ -1,3 +1,8 @@
+2011-01-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (Ffind): Use the correct subr information here, pass in
+	the DEFAULT keyword argument value correctly.
+
 2011-01-10  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* mc-alloc.c (get_used_list_index):
--- a/src/fns.c	Tue Jan 11 13:39:35 2011 +0000
+++ b/src/fns.c	Fri Jan 14 23:16:25 2011 +0000
@@ -3123,7 +3123,7 @@
   Boolint test_not_unboundp = 1;
   check_test_func_t check_test = NULL;
 
-  PARSE_KEYWORDS (Fposition, nargs, args, 9,
+  PARSE_KEYWORDS (Ffind, nargs, args, 9,
 		  (test, if_, test_not, if_not, key, start, end, from_end,
                    default_),
 		  (start = Qzero));
@@ -3132,7 +3132,7 @@
 					key, &test_not_unboundp);
 
   position (&object, item, sequence, check_test, test_not_unboundp,
-            test, key, start, end, from_end, Qnil, Qposition);
+            test, key, start, end, from_end, default_, Qposition);
 
   return object;
 }
--- a/tests/ChangeLog	Tue Jan 11 13:39:35 2011 +0000
+++ b/tests/ChangeLog	Fri Jan 14 23:16:25 2011 +0000
@@ -1,3 +1,8 @@
+2011-01-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (list): Test #'find, especially the
+	:default keyword, not specified by Common Lisp.
+
 2011-01-02  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el (test-fun): Test member*, assoc*,
--- a/tests/automated/lisp-tests.el	Tue Jan 11 13:39:35 2011 +0000
+++ b/tests/automated/lisp-tests.el	Fri Jan 14 23:16:25 2011 +0000
@@ -2790,4 +2790,30 @@
                             (copy-sequence string)
                             :end1 (* 2 string-length))))))
 
+(let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone))
+       (vector (map 'vector #'identity list))
+       (bit-vector (map 'bit-vector
+			#'(lambda (object) (if (fixnump object) 1 0)) list))
+       (string (map 'string 
+		    #'(lambda (object) (or (and (fixnump object)
+						(int-char object))
+					   (decode-char 'ucs #x20ac))) list))
+       (gensym (gensym)))
+  (Assert (null (find 'not-in-it list)))
+  (Assert (null (find 'not-in-it vector)))
+  (Assert (null (find 'not-in-it bit-vector)))
+  (Assert (null (find 'not-in-it string)))
+  (loop
+    for elt being each element in vector using (index position)
+    do
+    (Assert (eq elt (find elt list)))
+    (Assert (eq (elt list position) (find elt vector))))
+  (Assert (eq gensym (find 'not-in-it list :default gensym)))
+  (Assert (eq gensym (find 'not-in-it vector :default gensym)))
+  (Assert (eq gensym (find 'not-in-it bit-vector :default gensym)))
+  (Assert (eq gensym (find 'not-in-it string :default gensym)))
+  (Assert (eq 'hi-there (find 'hi-there list)))
+  ;; Different uninterned symbols with the same name.
+  (Assert (not (eq '#1=#:everyone (find '#1# list)))))
+
 ;;; end of lisp-tests.el