# HG changeset patch # User Aidan Kehoe # Date 1295046985 0 # Node ID 287499ff4c5feb21a66f828fb698a9c2fcbfac48 # Parent c9d31263ab7db633744accb5195727a4a343a3d7 Pass in the DEFAULT argument to position() as documented, #'find. src/ChangeLog addition: 2011-01-14 Aidan Kehoe * 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 * automated/lisp-tests.el (list): Test #'find, especially the :default keyword, not specified by Common Lisp. diff -r c9d31263ab7d -r 287499ff4c5f src/ChangeLog --- 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 + + * fns.c (Ffind): Use the correct subr information here, pass in + the DEFAULT keyword argument value correctly. + 2011-01-10 Aidan Kehoe * mc-alloc.c (get_used_list_index): diff -r c9d31263ab7d -r 287499ff4c5f src/fns.c --- 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; } diff -r c9d31263ab7d -r 287499ff4c5f tests/ChangeLog --- 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 + + * automated/lisp-tests.el (list): Test #'find, especially the + :default keyword, not specified by Common Lisp. + 2011-01-02 Aidan Kehoe * automated/lisp-tests.el (test-fun): Test member*, assoc*, diff -r c9d31263ab7d -r 287499ff4c5f tests/automated/lisp-tests.el --- 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