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