Mercurial > hg > xemacs-beta
changeset 5468:a9094f28f9a9
Merge with trunk.
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Wed, 19 Jan 2011 22:35:23 +0100 |
parents | 4ed2dedf36a1 (current diff) fde0802ee3e0 (diff) |
children | 2a8a04f73c15 |
files | lib-src/ChangeLog lib-src/fakemail.c lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el lisp/subr.el lisp/update-elc.el src/ChangeLog src/device-msw.c src/fns.c src/lisp.h src/s/freebsd.h src/s/hpux11.h src/s/usg5-4.h src/select.c src/symbols.c tests/ChangeLog tests/automated/lisp-tests.el |
diffstat | 18 files changed, 218 insertions(+), 190 deletions(-) [+] |
line wrap: on
line diff
--- a/lib-src/ChangeLog Fri Jan 14 23:32:08 2011 +0100 +++ b/lib-src/ChangeLog Wed Jan 19 22:35:23 2011 +0100 @@ -1,3 +1,8 @@ +2011-01-15 Mike Sperber <mike@xemacs.org> + + * fakemail.c: #include <osreldate.h> on FreeBSD, since we no + longer have freebsd.h. + 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * gnuserv.c:
--- a/lib-src/fakemail.c Fri Jan 14 23:32:08 2011 +0100 +++ b/lib-src/fakemail.c Wed Jan 19 22:35:23 2011 +0100 @@ -144,6 +144,10 @@ extern char *malloc (), *realloc (); #endif +#if defined(__FreeBSD__) +#include <osreldate.h> +#endif + #if defined(__FreeBSD_version) && __FreeBSD_version >= 400000 #define CURRENT_USER #endif
--- a/lisp/ChangeLog Fri Jan 14 23:32:08 2011 +0100 +++ b/lisp/ChangeLog Wed Jan 19 22:35:23 2011 +0100 @@ -1,3 +1,22 @@ +2011-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * cl-extra.el (concatenate): Accept more complicated TYPEs in this + function, handing the sequences over to #'coerce if we don't + understand them here. + * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its + compiler macro is more useful than doing that. + +2011-01-11 Aidan Kehoe <kehoea@parhasard.net> + + * subr.el (delete, delq, remove, remq): Move #'remove, #'remq + here, they don't belong in cl-seq.el; move #'delete, #'delq here + from fns.c, implement them in terms of #'delete*, allowing support + for sequences generally. + * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq + here, now the latter's no longer dumped. + * cl-macs.el (delete, delq): Add compiler macros transforming + #'delete and #'delq to #'delete* calls. + 2011-01-10 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis
--- a/lisp/cl-extra.el Fri Jan 14 23:32:08 2011 +0100 +++ b/lisp/cl-extra.el Wed Jan 19 22:35:23 2011 +0100 @@ -419,9 +419,9 @@ (case type (vector (apply 'vconcat seqs)) (string (apply 'concat seqs)) - (list (apply 'append (append seqs '(nil)))) + (list (reduce 'append seqs :from-end t :initial-value nil)) (bit-vector (apply 'bvconcat seqs)) - (t (error 'invalid-argument "Not a sequence type name" type)))) + (t (coerce (reduce 'append seqs :from-end t :initial-value nil) type)))) ;;; List functions.
--- a/lisp/cl-macs.el Fri Jan 14 23:32:08 2011 +0100 +++ b/lisp/cl-macs.el Wed Jan 19 22:35:23 2011 +0100 @@ -3340,12 +3340,44 @@ (list 'if (list* 'member* a list keys) list (list 'cons a list)) form)) -(define-compiler-macro remove (item sequence) - `(remove* ,item ,sequence :test #'equal)) - -(define-compiler-macro remq (item sequence) - `(remove* ,item ,sequence :test #'eq)) - +(define-compiler-macro delete (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val) + (characterp cl-const-expr-val))) + (cons 'delete* (cdr form)) + `(delete* ,@(cdr form) :test #'equal))))) + +(define-compiler-macro delq (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (not (cl-non-fixnum-number-p cl-const-expr-val))) + (cons 'delete* (cdr form)) + `(delete* ,@(cdr form) :test #'eq))))) + +(define-compiler-macro remove (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val) + (characterp cl-const-expr-val))) + (cons 'remove* (cdr form)) + `(remove* ,@(cdr form) :test #'equal))))) + +(define-compiler-macro remq (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (not (cl-non-fixnum-number-p cl-const-expr-val))) + (cons 'remove* (cdr form)) + `(remove* ,@(cdr form) :test #'eq))))) + (macrolet ((define-foo-if-compiler-macros (&rest alist) "Avoid the funcall, variable binding and keyword parsing overhead @@ -3797,10 +3829,9 @@ (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr))) -;;; Things that are inline. -(proclaim '(inline acons map concatenate -;; XEmacs omission: gethash is builtin - cl-set-elt revappend nreconc)) +;;; Things that are inline. XEmacs; the functions that used to be here have +;;; compiler macros or are built-in. +(proclaim '(inline cl-set-elt)) ;;; Things that are side-effect-free. Moved to byte-optimize.el ;(mapcar (function (lambda (x) (put x 'side-effect-free t)))
--- a/lisp/subr.el Fri Jan 14 23:32:08 2011 +0100 +++ b/lisp/subr.el Wed Jan 19 22:35:23 2011 +0100 @@ -146,6 +146,40 @@ (define-function ,@args))) +(defun delete (item sequence) + "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. + +The modified SEQUENCE is returned. Comparison is done with `equal'. + +If the first member of a list SEQUENCE is ITEM, there is no way to remove it +by side effect; therefore, write `(setq foo (delete element foo))' to be +sure of changing the value of `foo'. Also see: `remove'." + (delete* item sequence :test #'equal)) + +(defun delq (item sequence) + "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. + +The modified SEQUENCE is returned. Comparison is done with `eq'. If +SEQUENCE is a list and its first member is ITEM, there is no way to remove +it by side effect; therefore, write `(setq foo (delq element foo))' to be +sure of changing the value of `foo'." + (delete* item sequence :test #'eq)) + +(defun remove (item sequence) + "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'. + +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. +Also see: `remove*', `delete', `delete*'" + (remove* item sequence :test #'equal)) + +(defun remq (item sequence) + "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'. + +This is a non-destructive function; it makes a copy of SEQUENCE to avoid +corrupting the original SEQUENCE. See also the more general `remove*'." + (remove* item sequence :test #'eq)) + (defun assoc-default (key alist &optional test default) "Find object KEY in a pseudo-alist ALIST. ALIST is a list of conses or objects. Each element (or the element's car,
--- a/lisp/update-elc.el Fri Jan 14 23:32:08 2011 +0100 +++ b/lisp/update-elc.el Wed Jan 19 22:35:23 2011 +0100 @@ -381,7 +381,10 @@ (mapc #'(lambda (arg) (setq update-elc-files-to-compile - (delete arg update-elc-files-to-compile))) + (delete* arg update-elc-files-to-compile + :test (if default-file-system-ignore-case + #'equalp + #'equal)))) (append bc-bootstrap bootstrap-other)) (setq command-line-args (append
--- a/src/ChangeLog Fri Jan 14 23:32:08 2011 +0100 +++ b/src/ChangeLog Wed Jan 19 22:35:23 2011 +0100 @@ -1,3 +1,38 @@ +2011-01-18 Mike Sperber <mike@xemacs.org> + + * s/freebsd.h: Zap. Not really needed anymore, and it has unclear + license status. + +2011-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * s/usg5-4.h (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF): + That didn't work; attempt with qxestrcpy_ascii(), + qxestrncpy_ascii(). + +2011-01-14 Aidan Kehoe <kehoea@parhasard.net> + + * s/hpux11.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF): + * s/usg5-4.h (PTY_TTY_NAME_SPRINTF, PTY_NAME_SPRINTF): + Replace sprintf() with qxesprintf(), strcpy with qxestrpy(), + hopefully fixing some platform-specific C++ builds. + +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-11 Aidan Kehoe <kehoea@parhasard.net> + + * device-msw.c (Fmswindows_printer_list): Remove a Fdelete () + call here, remove the necessity for it. + * fns.c (Fdelete, Fdelq): + * lisp.h: + Move #'delete, #'delq to Lisp, implemented in terms of #'delete* + * select.c (Fown_selection_internal): + * select.c (handle_selection_clear): + Use delq_no_quit() in these functions, don't reimplement it or use + Fdelq(), which is now gone. + 2011-01-10 Aidan Kehoe <kehoea@parhasard.net> * mc-alloc.c (get_used_list_index):
--- a/src/device-msw.c Fri Jan 14 23:32:08 2011 +0100 +++ b/src/device-msw.c Wed Jan 19 22:35:23 2011 +0100 @@ -1327,9 +1327,12 @@ GCPRO2 (result, def_printer); + def_printer = msprinter_default_printer (); + while (num_printers--) { Extbyte *printer_name; + Lisp_Object printer_name_lisp; if (have_nt) { PRINTER_INFO_4 *info = (PRINTER_INFO_4 *) data_buf; @@ -1341,12 +1344,15 @@ printer_name = (Extbyte *) info->pPrinterName; } data_buf += enum_entry_size; - - result = Fcons (build_tstr_string (printer_name), result); + + printer_name_lisp = build_tstr_string (printer_name); + if (0 != qxestrcasecmp (XSTRING_DATA (def_printer), + XSTRING_DATA (printer_name_lisp))) + { + result = Fcons (printer_name_lisp, result); + } } - def_printer = msprinter_default_printer (); - result = Fdelete (def_printer, result); result = Fcons (def_printer, result); RETURN_UNGCPRO (result);
--- a/src/fns.c Fri Jan 14 23:32:08 2011 +0100 +++ b/src/fns.c Wed Jan 19 22:35:23 2011 +0100 @@ -3121,7 +3121,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)); @@ -3130,26 +3130,11 @@ 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; } -DEFUN ("delete", Fdelete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delete element foo))' to be sure -of changing the value of `foo'. -Also see: `remove'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_equal (elt, list_elt, 0))); - return list; -} - DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* Delete by side effect any occurrences of ELT as a member of LIST. The modified LIST is returned. Comparison is done with `old-equal'. @@ -3164,20 +3149,6 @@ return list; } -DEFUN ("delq", Fdelq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); - return list; -} - DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* Delete by side effect any occurrences of ELT as a member of LIST. The modified LIST is returned. Comparison is done with `old-eq'. @@ -11788,9 +11759,7 @@ DEFSUBR (Fposition); DEFSUBR (Ffind); - DEFSUBR (Fdelete); DEFSUBR (Fold_delete); - DEFSUBR (Fdelq); DEFSUBR (Fold_delq); DEFSUBR (FdeleteX); DEFSUBR (FremoveX);
--- a/src/lisp.h Fri Jan 14 23:32:08 2011 +0100 +++ b/src/lisp.h Wed Jan 19 22:35:23 2011 +0100 @@ -5207,8 +5207,6 @@ EXFUN (Fcopy_list, 1); EXFUN (Fcopy_sequence, 1); EXFUN (Fcopy_tree, 2); -EXFUN (Fdelete, 2); -EXFUN (Fdelq, 2); EXFUN (Fdestructive_alist_to_plist, 1); EXFUN (Felt, 2); MODULE_API EXFUN (Fequal, 2);
--- a/src/s/freebsd.h Fri Jan 14 23:32:08 2011 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -/* Synched up with: FSF 19.31. */ - -/* s/ file for freebsd system. */ - -/* '__FreeBSD__' is defined by the preprocessor on FreeBSD-1.1 and up. - Earlier versions do not have shared libraries, so inhibit them. - You can inhibit them on newer systems if you wish - by defining NO_SHARED_LIBS. */ -#ifndef __FreeBSD__ -#define NO_SHARED_LIBS -#endif - -/* Get most of the stuff from bsd4.3 */ -#include "bsd4-3.h" - -/* For mem-limits.h. */ -#define BSD4_2 - -/* These aren't needed, since we have getloadavg. */ -#undef KERNEL_FILE -#undef LDAV_SYMBOL - -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) - -#define INTERRUPTIBLE_OPEN - -#define LIBS_DEBUG -/* FreeBSD 2.2 or later */ -#ifndef __FreeBSD_version -#include <osreldate.h> -#endif -#if __FreeBSD_version >= 199701 && __FreeBSD_version < 600006 -#define LIBS_SYSTEM "-lutil -lxpg4" -#else -#define LIBS_SYSTEM "-lutil" -#endif - -#ifndef NOT_C_CODE -#ifdef BSD /* fixing BSD define */ -#undef BSD -#endif -#include <sys/param.h> -/* Kludge to work around setlocale(LC_ALL,...) not working after 01/1997 */ -#if __FreeBSD_version >= 199701 && __FreeBSD_version < 226000 -#ifdef HAVE_X_WINDOWS -#include <X11/Xlocale.h> -#define setlocale(locale_category, locale_spec) setlocale(LC_CTYPE, locale_spec) -#endif /* HAVE X */ -#endif /* FreeBSD >= 199701 && < 226000 */ -#endif /* C code */ - -#define LIBS_TERMCAP "-ltermcap" - -#ifdef __ELF__ /* since from 3.0-CURRENT(maybe 19980831 or later) */ -#ifndef NOT_C_CODE -#include <stddef.h> -#endif -#define LD_SWITCH_SYSTEM -#define START_FILES pre-crt0.o /usr/lib/crt1.o /usr/lib/crti.o /usr/lib/crtbegin.o -#define UNEXEC "unexelf.o" -#define LIB_STANDARD -lgcc -lc -lgcc /usr/lib/crtend.o /usr/lib/crtn.o -#define LINKER "$(CC) -nostdlib" -#undef LIB_GCC -#define LIB_GCC - -#else /* not __ELF__ */ - -#ifndef NO_SHARED_LIBS -#if 0 /* mrb */ -#define LIB_GCC "-lgcc" -#define LD_SWITCH_SYSTEM "-dc -dp -e start" -#define START_FILES "pre-crt0.o /usr/lib/crt0.o" -#else /* mrb */ -#define ORDINARY_LINK -#undef LIB_GCC -#undef LD_SWITCH_SYSTEM -#undef START_FILES -#endif /* mrb */ - -#define HAVE_TEXT_START /* No need to define `start_of_text'. */ -#define UNEXEC "unexfreebsd.o" -#define RUN_TIME_REMAP - -#ifndef N_TRELOFF -#define N_PAGSIZ(x) __LDPGSZ -#define N_BSSADDR(x) (N_ALIGN(x, N_DATADDR(x)+x.a_data)) -#define N_TRELOFF(x) N_RELOFF(x) -#endif -#else /* NO_SHARED_LIBS */ -#ifdef __FreeBSD__ /* shared libs are available, but the user prefers - not to use them. */ -#define LD_SWITCH_SYSTEM "-Bstatic" -#define A_TEXT_OFFSET(x) (sizeof (struct exec)) -#define A_TEXT_SEEK(hdr) (N_TXTOFF(hdr) + A_TEXT_OFFSET(hdr)) -#endif /* __FreeBSD__ */ -#endif /* NO_SHARED_LIBS */ - -#endif /* not __ELF__ */ - -/* #define NO_TERMIO */ /* detected in configure */ -#define DECLARE_GETPWUID_WITH_UID_T - -/* freebsd uses OXTABS instead of the expected TAB3. */ -#define TABDLY OXTABS -#define TAB3 OXTABS
--- a/src/s/hpux11.h Fri Jan 14 23:32:08 2011 +0100 +++ b/src/s/hpux11.h Wed Jan 19 22:35:23 2011 +0100 @@ -102,11 +102,11 @@ /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ - sprintf (pty_name, "/dev/pty/tty%c%x", c, i); + qxesprintf (pty_name, "/dev/pty/tty%c%x", c, i); /* This is how to get the device name of the control end of a pty. */ #define PTY_NAME_SPRINTF \ - sprintf (pty_name, "/dev/ptym/pty%c%x", c, i); + qxesprintf (pty_name, "/dev/ptym/pty%c%x", c, i); #ifdef HPUX_USE_SHLIBS #define LD_SWITCH_SYSTEM
--- a/src/s/usg5-4.h Fri Jan 14 23:32:08 2011 +0100 +++ b/src/s/usg5-4.h Wed Jan 19 22:35:23 2011 +0100 @@ -122,7 +122,7 @@ /* This sets the name of the master side of the PTY. */ -#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx"); +#define PTY_NAME_SPRINTF qxestrcpy_ascii (pty_name, "/dev/ptmx"); /* This sets the name of the slave side of the PTY. On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() from @@ -148,7 +148,8 @@ { close (fd); return -1; } \ if (!(ptyname = ptsname (fd))) \ { close (fd); return -1; } \ - strncpy (pty_name, ptyname, sizeof (pty_name)); \ + qxestrncpy_ascii (pty_name, ptyname, \ + sizeof (pty_name)); \ pty_name[sizeof (pty_name) - 1] = 0; \ }
--- a/src/select.c Fri Jan 14 23:32:08 2011 +0100 +++ b/src/select.c Wed Jan 19 22:35:23 2011 +0100 @@ -181,19 +181,8 @@ if (!NILP (local_selection_data)) { owned_p = 1; - /* Don't use Fdelq() as that may QUIT;. */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } + Vselection_alist + = delq_no_quit (local_selection_data, Vselection_alist); } } else @@ -410,21 +399,8 @@ /* Well, we already believe that we don't own it, so that's just fine. */ if (NILP (local_selection_data)) return; - /* Otherwise, we're really honest and truly being told to drop it. - Don't use Fdelq() as that may QUIT;. - */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } + /* Otherwise, we're really honest and truly being told to drop it. */ + Vselection_alist = delq_no_quit (local_selection_data, Vselection_alist); /* Let random lisp code notice that the selection has been stolen. */
--- a/src/symbols.c Fri Jan 14 23:32:08 2011 +0100 +++ b/src/symbols.c Wed Jan 19 22:35:23 2011 +0100 @@ -2544,7 +2544,8 @@ = buffer_local_alist_element (current_buffer, variable, bfwd); if (!NILP (alist_element)) - current_buffer->local_var_alist = Fdelq (alist_element, alist); + current_buffer->local_var_alist = delq_no_quit (alist_element, + alist); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value */
--- a/tests/ChangeLog Fri Jan 14 23:32:08 2011 +0100 +++ b/tests/ChangeLog Wed Jan 19 22:35:23 2011 +0100 @@ -1,3 +1,14 @@ +2011-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (list): Test #'concatenate, especially + with more complicated TYPEs, which were previously not accepted by + the function. + +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 Fri Jan 14 23:32:08 2011 +0100 +++ b/tests/automated/lisp-tests.el Wed Jan 19 22:35:23 2011 +0100 @@ -2788,4 +2788,44 @@ (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)))) + + ;; Test concatenate. + (Assert (equal list (concatenate 'list vector))) + (Assert (equal list (concatenate 'list (subseq vector 0 4) + (subseq list 4)))) + (Assert (equal vector (concatenate 'vector list))) + (Assert (equal vector (concatenate `(vector * ,(length vector)) list))) + (Assert (equal string (concatenate `(vector character ,(length string)) + (append string nil)))) + (Assert (equal bit-vector (concatenate 'bit-vector (subseq bit-vector 0 4) + (append (subseq bit-vector 4) nil)))) + (Assert (equal bit-vector (concatenate `(vector bit ,(length bit-vector)) + (subseq bit-vector 0 4) + (append (subseq bit-vector 4) nil))))) + ;;; end of lisp-tests.el