changeset 5374:d967d96ca043

Conditionalise the old-* functions and byte codes at compile time. src/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * config.h.in (SUPPORT_CONFOUNDING_FUNCTIONS): New #define, equivalent NEED_TO_HANDLE_21_4_CODE by default, describing whether this XEmacs should support the old-eq, old-equal and related functions and byte codes. * bytecode.c (UNUSED): Only interpret old-eq, old-equal, old-memq if SUPPORT_CONFOUNDING_FUNCTIONS is defined. * data.c: Move Fold_eq to fns.c with the rest of the Fold_* functions. * fns.c: * fns.c (Fmemq): * fns.c (memq_no_quit): * fns.c (assoc_no_quit): * fns.c (Frassq): * fns.c (Fequal): * fns.c (Fold_equal): * fns.c (syms_of_fns): Group old-eq, old-equal, old-memq etc together, surround them with #ifdef SUPPORT_CONFOUNDING_FUNCTIONS. lisp/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: Don't generate the old-eq, old-memq, old-equal bytecodes any more, but keep the information about them around for the sake of the disassembler. man/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * lispref/objects.texi (Character Type): * lispref/objects.texi (Equality Predicates): No longer document `old-eq', `old-equal', they haven't been used in years. tests/ChangeLog addition: 2011-03-17 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Only test the various old-* function if old-eq is bound and a subr.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 17 Mar 2011 20:13:00 +0000
parents 6c3a695f54f5
children 2fba45e5b48d
files lisp/ChangeLog lisp/bytecomp.el man/ChangeLog man/lispref/objects.texi src/ChangeLog src/bytecode.c src/config.h.in src/data.c src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
diffstat 11 files changed, 224 insertions(+), 213 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Mar 14 21:04:45 2011 +0000
+++ b/lisp/ChangeLog	Thu Mar 17 20:13:00 2011 +0000
@@ -1,3 +1,10 @@
+2011-03-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el:
+	Don't generate the old-eq, old-memq, old-equal bytecodes any more,
+	but keep the information about them around for the sake of the
+	disassembler.
+
 2011-03-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* isearch-mode.el (isearch-mode-map):
--- a/lisp/bytecomp.el	Mon Mar 14 21:04:45 2011 +0000
+++ b/lisp/bytecomp.el	Thu Mar 17 20:13:00 2011 +0000
@@ -3161,8 +3161,8 @@
 (byte-defop-compiler skip-chars-forward     1-2+1)
 (byte-defop-compiler skip-chars-backward    1-2+1)
 (byte-defop-compiler eq			2)
-(byte-defop-compiler20 old-eq 	 	2)
-(byte-defop-compiler20 old-memq		2)
+; (byte-defop-compiler20 old-eq 	 	2)
+; (byte-defop-compiler20 old-memq		2)
 (byte-defop-compiler cons		2)
 (byte-defop-compiler aref		2)
 (byte-defop-compiler get		2+1)
@@ -3179,7 +3179,7 @@
 (byte-defop-compiler string<		2)
 (byte-defop-compiler (string-equal byte-string=) 2)
 (byte-defop-compiler (string-lessp byte-string<) 2)
-(byte-defop-compiler20 old-equal	2)
+; (byte-defop-compiler20 old-equal	2)
 (byte-defop-compiler nthcdr		2)
 (byte-defop-compiler elt		2)
 (byte-defop-compiler20 old-member	2)
--- a/man/ChangeLog	Mon Mar 14 21:04:45 2011 +0000
+++ b/man/ChangeLog	Thu Mar 17 20:13:00 2011 +0000
@@ -1,3 +1,10 @@
+2011-03-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lispref/objects.texi (Character Type):
+	* lispref/objects.texi (Equality Predicates):
+	No longer document `old-eq', `old-equal', they haven't been used
+	in years.
+
 2011-03-01  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* lispref/commands.texi (Using Interactive):
--- a/man/lispref/objects.texi	Mon Mar 14 21:04:45 2011 +0000
+++ b/man/lispref/objects.texi	Thu Mar 17 20:13:00 2011 +0000
@@ -349,19 +349,6 @@
 primitive types. (This change was necessary in order for @sc{mule},
 i.e. Asian-language, support to be correctly implemented.)
 
-  Even in XEmacs version 20, remnants of the equivalence between
-characters and integers still exist; this is termed the @dfn{char-int
-confoundance disease}.  In particular, many functions such as @code{eq},
-@code{equal}, and @code{memq} have equivalent functions (@code{old-eq},
-@code{old-equal}, @code{old-memq}, etc.) that pretend like characters
-are integers are the same.  Byte code compiled under any version 19
-Emacs will have all such functions mapped to their @code{old-} equivalents
-when the byte code is read into XEmacs 20.  This is to preserve
-compatibility---Emacs 19 converts all constant characters to the equivalent
-integer during byte-compilation, and thus there is no other way to preserve
-byte-code compatibility even if the code has specifically been written
-with the distinction between characters and integers in mind.
-
   Every character has an equivalent integer, called the @dfn{character
 code}.  For example, the character @kbd{A} is represented as the
 @w{integer 65}, following the standard @sc{ascii} representation of
@@ -2317,32 +2304,6 @@
 
 @end defun
 
-@defun old-eq object1 object2
-This function exists under XEmacs 20 and is exactly like @code{eq}
-except that it suffers from the char-int confoundance disease.
-In other words, it returns @code{t} if given a character and the
-equivalent integer, even though the objects are of different types!
-You should @emph{not} ever call this function explicitly in your
-code.  However, be aware that all calls to @code{eq} in byte code
-compiled under version 19 map to @code{old-eq} in XEmacs 20.
-(Likewise for @code{old-equal}, @code{old-memq}, @code{old-member},
-@code{old-assq} and  @code{old-assoc}.)
-
-@example
-@group
-;; @r{Remember, this does not apply under XEmacs 19.}
-?A
-     @result{} ?A
-(char-int ?A)
-     @result{} 65
-(old-eq ?A 65)
-     @result{} t               ; @r{Eek, we've been infected.}
-(eq ?A 65)
-     @result{} nil             ; @r{We are still healthy.}
-@end group
-@end example
-@end defun
-
 @defun eql object1 object2
 
 This function returns @code{t} if the two arguments are the same object,
--- a/src/ChangeLog	Mon Mar 14 21:04:45 2011 +0000
+++ b/src/ChangeLog	Thu Mar 17 20:13:00 2011 +0000
@@ -1,3 +1,25 @@
+2011-03-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* config.h.in (SUPPORT_CONFOUNDING_FUNCTIONS): New #define,
+	equivalent NEED_TO_HANDLE_21_4_CODE by default, describing whether
+	this XEmacs should support the old-eq, old-equal and related
+	functions and byte codes.
+	* bytecode.c (UNUSED):
+	Only interpret old-eq, old-equal, old-memq if
+	SUPPORT_CONFOUNDING_FUNCTIONS is defined.
+	* data.c:
+	Move Fold_eq to fns.c with the rest of the Fold_* functions.
+	* fns.c:
+	* fns.c (Fmemq):
+	* fns.c (memq_no_quit):
+	* fns.c (assoc_no_quit):
+	* fns.c (Frassq):
+	* fns.c (Fequal):
+	* fns.c (Fold_equal):
+	* fns.c (syms_of_fns):
+	Group old-eq, old-equal, old-memq etc together, surround them with
+	#ifdef SUPPORT_CONFOUNDING_FUNCTIONS.
+
 2011-03-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* glyphs-eimage.c (png_instantiate):
--- a/src/bytecode.c	Mon Mar 14 21:04:45 2011 +0000
+++ b/src/bytecode.c	Thu Mar 17 20:13:00 2011 +0000
@@ -1692,6 +1692,8 @@
 	break;
       }
 
+#ifdef SUPPORT_CONFOUNDING_FUNCTIONS
+
     case Bold_eq:
       {
 	Lisp_Object arg = POP;
@@ -1727,6 +1729,8 @@
 	break;
       }
 
+#endif
+
     case Bbind_multiple_value_limits:
       {
         Lisp_Object upper = POP, first = TOP, speccount;
--- a/src/config.h.in	Mon Mar 14 21:04:45 2011 +0000
+++ b/src/config.h.in	Thu Mar 17 20:13:00 2011 +0000
@@ -1183,4 +1183,6 @@
 /* Do we need to be able to run code compiled by and written for 21.4? */
 #define NEED_TO_HANDLE_21_4_CODE 1
 
+#define SUPPORT_CONFOUNDING_FUNCTIONS NEED_TO_HANDLE_21_4_CODE
+
 #endif /* _SRC_CONFIG_H_ */
--- a/src/data.c	Mon Mar 14 21:04:45 2011 +0000
+++ b/src/data.c	Thu Mar 17 20:13:00 2011 +0000
@@ -183,24 +183,6 @@
   return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil;
 }
 
-DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
-Return t if the two args are (in most cases) the same Lisp object.
-
-Special kludge: A character is considered `old-eq' to its equivalent integer
-even though they are not the same object and are in fact of different
-types.  This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
-preserve byte-code compatibility with v19.  This kludge is known as the
-\"char-int confoundance disease\" and appears in a number of other
-functions with `old-foo' equivalents.
-
-Do not use this function!
-*/
-       (object1, object2))
-{
-  /* #### blasphemy */
-  return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil;
-}
-
 DEFUN ("null", Fnull, 1, 1, 0, /*
 Return t if OBJECT is nil.
 */
@@ -3568,7 +3550,6 @@
   DEFSUBR (Fdiv);
 #endif
   DEFSUBR (Feq);
-  DEFSUBR (Fold_eq);
   DEFSUBR (Fnull);
   Ffset (intern ("not"), intern ("null"));
   DEFSUBR (Flistp);
--- a/src/fns.c	Mon Mar 14 21:04:45 2011 +0000
+++ b/src/fns.c	Thu Mar 17 20:13:00 2011 +0000
@@ -72,7 +72,6 @@
 extern Fixnum max_lisp_eval_depth;
 extern int lisp_eval_depth;
 
-static int internal_old_equal (Lisp_Object, Lisp_Object, int);
 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
 
 static DOESNT_RETURN
@@ -2581,22 +2580,6 @@
   return Qnil;
 }
 
-DEFUN ("old-member", Fold_member, 2, 2, 0, /*
-Return non-nil if ELT is an element of LIST.  Comparison done with `old-equal'.
-The value is actually the tail of LIST whose car is ELT.
-This function is provided only for byte-code compatibility with v19.
-Do not use it.
-*/
-       (elt, list))
-{
-  EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
-    {
-      if (internal_old_equal (elt, list_elt, 0))
-        return tail;
-    }
-  return Qnil;
-}
-
 DEFUN ("memq", Fmemq, 2, 2, 0, /*
 Return non-nil if ELT is an element of LIST.  Comparison done with `eq'.
 The value is actually the tail of LIST whose car is ELT.
@@ -2611,22 +2594,6 @@
   return Qnil;
 }
 
-DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
-Return non-nil if ELT is an element of LIST.  Comparison done with `old-eq'.
-The value is actually the tail of LIST whose car is ELT.
-This function is provided only for byte-code compatibility with v19.
-Do not use it.
-*/
-       (elt, list))
-{
-  EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
-    {
-      if (HACKEQ_UNSAFE (elt, list_elt))
-        return tail;
-    }
-  return Qnil;
-}
-
 Lisp_Object
 memq_no_quit (Lisp_Object elt, Lisp_Object list)
 {
@@ -2822,21 +2789,6 @@
   return Qnil;
 }
 
-DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
-Return non-nil if KEY is `old-equal' to the car of an element of ALIST.
-The value is actually the element of ALIST whose car equals KEY.
-*/
-       (key, alist))
-{
-  /* This function can GC. */
-  EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-    {
-      if (internal_old_equal (key, elt_car, 0))
-	return elt;
-    }
-  return Qnil;
-}
-
 Lisp_Object
 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
 {
@@ -2860,23 +2812,6 @@
   return Qnil;
 }
 
-DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
-Return non-nil if KEY is `old-eq' to the car of an element of ALIST.
-The value is actually the element of ALIST whose car is KEY.
-Elements of ALIST that are not conses are ignored.
-This function is provided only for byte-code compatibility with v19.
-Do not use it.
-*/
-       (key, alist))
-{
-  EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-    {
-      if (HACKEQ_UNSAFE (key, elt_car))
-	return elt;
-    }
-  return Qnil;
-}
-
 /* Like Fassq but never report an error and do not allow quits.
    Use only on lists known never to be circular.  */
 
@@ -2960,20 +2895,6 @@
   return Qnil;
 }
 
-DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
-Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST.
-The value is actually the element of ALIST whose cdr equals VALUE.
-*/
-       (value, alist))
-{
-  EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-    {
-      if (internal_old_equal (value, elt_cdr, 0))
-	return elt;
-    }
-  return Qnil;
-}
-
 DEFUN ("rassq", Frassq, 2, 2, 0, /*
 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST.
 The value is actually the element of ALIST whose cdr is VALUE.
@@ -3278,34 +3199,6 @@
   return object;
 }
 
-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'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (old-delete element foo))' to be sure
-of changing the value of `foo'.
-*/
-       (elt, list))
-{
-  EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
-				(internal_old_equal (elt, list_elt, 0)));
-  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'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
-changing the value of `foo'.
-*/
-       (elt, list))
-{
-  EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
-				(HACKEQ_UNSAFE (elt, list_elt)));
-  return list;
-}
-
 /* Like Fdelq, but caller must ensure that LIST is properly
    nil-terminated and ebola-free. */
 
@@ -6537,26 +6430,6 @@
     return internal_equal (obj1, obj2, depth);
 }
 
-/* Note that we may be calling sub-objects that will use
-   internal_equal() (instead of internal_old_equal()).  Oh well.
-   We will get an Ebola note if there's any possibility of confusion,
-   but that seems unlikely. */
-
-static int
-internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
-  if (depth + lisp_eval_depth > max_lisp_eval_depth)
-    stack_overflow ("Stack overflow in equal", Qunbound);
-  QUIT;
-  if (HACKEQ_UNSAFE (obj1, obj2))
-    return 1;
-  /* Note that (equal 20 20.0) should be nil */
-  if (XTYPE (obj1) != XTYPE (obj2))
-    return 0;
-
-  return internal_equal (obj1, obj2, depth);
-}
-
 DEFUN ("equal", Fequal, 2, 2, 0, /*
 Return t if two Lisp objects have similar structure and contents.
 They must have the same data type.
@@ -6600,6 +6473,134 @@
   return internal_equalp (object1, object2, 0) ? Qt : Qnil;
 }
 
+#ifdef SUPPORT_CONFOUNDING_FUNCTIONS
+
+/* Note that we may be calling sub-objects that will use
+   internal_equal() (instead of internal_old_equal()).  Oh well.
+   We will get an Ebola note if there's any possibility of confusion,
+   but that seems unlikely. */
+
+static int
+internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+{
+  if (depth + lisp_eval_depth > max_lisp_eval_depth)
+    stack_overflow ("Stack overflow in equal", Qunbound);
+  QUIT;
+  if (HACKEQ_UNSAFE (obj1, obj2))
+    return 1;
+  /* Note that (equal 20 20.0) should be nil */
+  if (XTYPE (obj1) != XTYPE (obj2))
+    return 0;
+
+  return internal_equal (obj1, obj2, depth);
+}
+
+DEFUN ("old-member", Fold_member, 2, 2, 0, /*
+Return non-nil if ELT is an element of LIST.  Comparison done with `old-equal'.
+The value is actually the tail of LIST whose car is ELT.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+       (elt, list))
+{
+  EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
+    {
+      if (internal_old_equal (elt, list_elt, 0))
+        return tail;
+    }
+  return Qnil;
+}
+
+DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
+Return non-nil if ELT is an element of LIST.  Comparison done with `old-eq'.
+The value is actually the tail of LIST whose car is ELT.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+       (elt, list))
+{
+  EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
+    {
+      if (HACKEQ_UNSAFE (elt, list_elt))
+        return tail;
+    }
+  return Qnil;
+}
+
+DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
+Return non-nil if KEY is `old-equal' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car equals KEY.
+*/
+       (key, alist))
+{
+  /* This function can GC. */
+  EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+    {
+      if (internal_old_equal (key, elt_car, 0))
+	return elt;
+    }
+  return Qnil;
+}
+
+DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
+Return non-nil if KEY is `old-eq' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car is KEY.
+Elements of ALIST that are not conses are ignored.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+       (key, alist))
+{
+  EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+    {
+      if (HACKEQ_UNSAFE (key, elt_car))
+	return elt;
+    }
+  return Qnil;
+}
+
+DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
+Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST.
+The value is actually the element of ALIST whose cdr equals VALUE.
+*/
+       (value, alist))
+{
+  EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+    {
+      if (internal_old_equal (value, elt_cdr, 0))
+	return elt;
+    }
+  return Qnil;
+}
+
+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'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (old-delete element foo))' to be sure
+of changing the value of `foo'.
+*/
+       (elt, list))
+{
+  EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
+				(internal_old_equal (elt, list_elt, 0)));
+  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'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
+changing the value of `foo'.
+*/
+       (elt, list))
+{
+  EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
+				(HACKEQ_UNSAFE (elt, list_elt)));
+  return list;
+}
+
 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
 Return t if two Lisp objects have similar structure and contents.
 They must have the same data type.
@@ -6614,6 +6615,26 @@
   return internal_old_equal (object1, object2, 0) ? Qt : Qnil;
 }
 
+DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
+Return t if the two args are (in most cases) the same Lisp object.
+
+Special kludge: A character is considered `old-eq' to its equivalent integer
+even though they are not the same object and are in fact of different
+types.  This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
+preserve byte-code compatibility with v19.  This kludge is known as the
+\"char-int confoundance disease\" and appears in a number of other
+functions with `old-foo' equivalents.
+
+Do not use this function!
+*/
+       (object1, object2))
+{
+  /* #### blasphemy */
+  return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil;
+}
+
+#endif
+
 
 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
 					   Lisp_Object start,
@@ -11798,25 +11819,17 @@
   DEFSUBR (Fbutlast);
   DEFSUBR (Fnbutlast);
   DEFSUBR (Fmember);
-  DEFSUBR (Fold_member);
   DEFSUBR (Fmemq);
-  DEFSUBR (Fold_memq);
   DEFSUBR (FmemberX);
   DEFSUBR (Fadjoin);
   DEFSUBR (Fassoc);
-  DEFSUBR (Fold_assoc);
   DEFSUBR (Fassq);
-  DEFSUBR (Fold_assq);
   DEFSUBR (Frassoc);
-  DEFSUBR (Fold_rassoc);
   DEFSUBR (Frassq);
-  DEFSUBR (Fold_rassq);
 
   DEFSUBR (Fposition);
   DEFSUBR (Ffind);
 
-  DEFSUBR (Fold_delete);
-  DEFSUBR (Fold_delq);
   DEFSUBR (FdeleteX);
   DEFSUBR (FremoveX);
   DEFSUBR (Fremassoc);
@@ -11853,8 +11866,20 @@
   DEFSUBR (Fobject_setplist);
   DEFSUBR (Fequal);
   DEFSUBR (Fequalp);
+  DEFSUBR (Ffill);
+
+#ifdef SUPPORT_CONFOUNDING_FUNCTIONS
+  DEFSUBR (Fold_member);
+  DEFSUBR (Fold_memq);
+  DEFSUBR (Fold_assoc);
+  DEFSUBR (Fold_assq);
+  DEFSUBR (Fold_rassoc);
+  DEFSUBR (Fold_rassq);
+  DEFSUBR (Fold_delete);
+  DEFSUBR (Fold_delq);
   DEFSUBR (Fold_equal);
-  DEFSUBR (Ffill);
+  DEFSUBR (Fold_eq);
+#endif
 
   DEFSUBR (FassocX);
   DEFSUBR (FrassocX);
--- a/tests/ChangeLog	Mon Mar 14 21:04:45 2011 +0000
+++ b/tests/ChangeLog	Thu Mar 17 20:13:00 2011 +0000
@@ -1,3 +1,9 @@
+2011-03-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Only test the various old-* function if old-eq is bound and a
+	subr.
+
 2011-03-11  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/byte-compiler-tests.el:
--- a/tests/automated/lisp-tests.el	Mon Mar 14 21:04:45 2011 +0000
+++ b/tests/automated/lisp-tests.el	Thu Mar 17 20:13:00 2011 +0000
@@ -796,18 +796,18 @@
 	 (Check-Error (malformed-list wrong-type-argument) (,fun nil 1))
 	 ,@(loop for n in '(1 2 2000)
 	     collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
-     (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
-
+     (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))
+     (test-old-funs (&rest funs)
+       `(when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq)))
+         ,@(loop for fun in funs collect `(test-fun ,fun)))))
   (test-funs member* member memq 
              assoc* assoc assq 
              rassoc* rassoc rassq 
              delete* delete delq 
              remove* remove remq 
-             old-member old-memq 
-             old-assoc old-assq 
-             old-rassoc old-rassq 
-             old-delete old-delq 
-             remassoc remassq remrassoc remrassq))
+             remassoc remassq remrassoc remrassq)
+  (test-old-funs old-member old-memq old-assoc old-assq old-rassoc old-rassq 
+                 old-delete old-delq))
 
 (let ((x '((1 . 2) 3 (4 . 5))))
   (Assert (eq (assoc  1 x) (car x)))
@@ -891,19 +891,15 @@
   (Assert (let* ((x (a)) (y (remassq   6 x))) (and (eq x y) (equal y (a)))))
   (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
   (Assert (let* ((x (a)) (y (remrassq  6 x))) (and (eq x y) (equal y (a)))))
-
   (Assert (let* ((x (a)) (y (delete     3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
   (Assert (let* ((x (a)) (y (delq       3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-
   (Assert (let* ((x (a)) (y (delete     '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
   (Assert (let* ((x (a)) (y (delq       '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
-  (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
-  )
-
-
+  (when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq)))
+    (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
+    (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
+    (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
+    (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))))
 
 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
   (Assert (let* ((x (a)) (y (remassoc  "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))