changeset: 5374:d967d96ca043 parent: 5372:6c3a695f54f5 user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Thu Mar 17 20:13:00 2011 +0000 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 description: Conditionalise the old-* functions and byte codes at compile time. src/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * automated/lisp-tests.el: Only test the various old-* function if old-eq is bound and a subr. diff -r 6c3a695f54f5 -r d967d96ca043 lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * isearch-mode.el (isearch-mode-map): diff -r 6c3a695f54f5 -r d967d96ca043 lisp/bytecomp.el --- 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) diff -r 6c3a695f54f5 -r d967d96ca043 man/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * lispref/commands.texi (Using Interactive): diff -r 6c3a695f54f5 -r d967d96ca043 man/lispref/objects.texi --- 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 ＠＠ -348,19 +348,6 ＠＠ the modern convention is followed, and characters are their own 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 ＠＠ -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, diff -r 6c3a695f54f5 -r d967d96ca043 src/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * glyphs-eimage.c (png_instantiate): diff -r 6c3a695f54f5 -r d967d96ca043 src/bytecode.c --- 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; ＠＠ -1726,6 +1728,8 ＠＠ TOP_LVALUE = Fold_assq (TOP, arg); break; } + +#endif case Bbind_multiple_value_limits: { diff -r 6c3a695f54f5 -r d967d96ca043 src/config.h.in --- 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_ */ diff -r 6c3a695f54f5 -r d967d96ca043 src/data.c --- a/src/data.c Mon Mar 14 21:04:45 2011 +0000 +++ b/src/data.c Thu Mar 17 20:13:00 2011 +0000 ＠＠ -181,24 +181,6 ＠＠ (object1, object2)) { 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, /* ＠＠ -3568,7 +3550,6 ＠＠ DEFSUBR (Fdiv); #endif DEFSUBR (Feq); - DEFSUBR (Fold_eq); DEFSUBR (Fnull); Ffset (intern ("not"), intern ("null")); DEFSUBR (Flistp); diff -r 6c3a695f54f5 -r d967d96ca043 src/fns.c --- 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. ＠＠ -2606,22 +2589,6 ＠＠ EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) { if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) - 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; ＠＠ -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. */ ＠＠ -2955,20 +2890,6 ＠＠ EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) { if (internal_equal (value, elt_cdr, 0)) - 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; ＠＠ -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,6 +6430,51 ＠＠ 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. +Conses are compared by comparing the cars and the cdrs. +Vectors and strings are compared element by element. +Numbers are compared by value. Symbols must match exactly. +*/ + (object1, object2)) +{ + return internal_equal (object1, object2, 0) ? Qt : Qnil; +} + +DEFUN ("equalp", Fequalp, 2, 2, 0, /* +Return t if two Lisp objects have similar structure and contents. + +This is like `equal', except that it accepts numerically equal +numbers of different types (float, integer, bignum, bigfloat), and also +compares strings and characters case-insensitively. + +Type objects that are arrays (that is, strings, bit-vectors, and vectors) +of the same length and with contents that are `equalp' are themselves +`equalp', regardless of whether the two objects have the same type. + +Other objects whose primary purpose is as containers of other objects are +`equalp' if they would otherwise be equal (same length, type, etc.) and +their contents are `equalp'. This goes for conses, weak lists, +weak boxes, ephemerons, specifiers, hash tables, char tables and range +tables. However, objects that happen to contain other objects but are not +primarily designed for this purpose (e.g. compiled functions, events or +display-related objects such as glyphs, faces or extents) are currently +compared using `equalp' the same way as using `equal'. + +More specifically, two hash tables are `equalp' if they have the same test +(see `hash-table-test'), the same number of entries, and the same value for +`hash-table-weakness', and if, for each entry in one hash table, its key is +equivalent to a key in the other hash table using the hash table test, and +its value is `equalp' to the other hash table's value for that key. +*/ + (object1, object2)) +{ + 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, ＠＠ -6557,47 +6495,110 ＠＠ 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. -Conses are compared by comparing the cars and the cdrs. -Vectors and strings are compared element by element. -Numbers are compared by value. Symbols must match exactly. -*/ - (object1, object2)) -{ - return internal_equal (object1, object2, 0) ? Qt : Qnil; -} - -DEFUN ("equalp", Fequalp, 2, 2, 0, /* -Return t if two Lisp objects have similar structure and contents. - -This is like `equal', except that it accepts numerically equal -numbers of different types (float, integer, bignum, bigfloat), and also -compares strings and characters case-insensitively. - -Type objects that are arrays (that is, strings, bit-vectors, and vectors) -of the same length and with contents that are `equalp' are themselves -`equalp', regardless of whether the two objects have the same type. - -Other objects whose primary purpose is as containers of other objects are -`equalp' if they would otherwise be equal (same length, type, etc.) and -their contents are `equalp'. This goes for conses, weak lists, -weak boxes, ephemerons, specifiers, hash tables, char tables and range -tables. However, objects that happen to contain other objects but are not -primarily designed for this purpose (e.g. compiled functions, events or -display-related objects such as glyphs, faces or extents) are currently -compared using `equalp' the same way as using `equal'. - -More specifically, two hash tables are `equalp' if they have the same test -(see `hash-table-test'), the same number of entries, and the same value for -`hash-table-weakness', and if, for each entry in one hash table, its key is -equivalent to a key in the other hash table using the hash table test, and -its value is `equalp' to the other hash table's value for that key. -*/ - (object1, object2)) -{ - return internal_equalp (object1, object2, 0) ? Qt : 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 ("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, /* ＠＠ -6613,6 +6614,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, ＠＠ -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); diff -r 6c3a695f54f5 -r d967d96ca043 tests/ChangeLog --- 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(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Only test the various old-* function if old-eq is bound and a + subr. + 2011-03-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/byte-compiler-tests.el: diff -r 6c3a695f54f5 -r d967d96ca043 tests/automated/lisp-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")))))) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches