Mercurial > hg > xemacs-beta
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