mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-04-21 21:41:40 -07:00
Fix assoc_no_quit so that it does not quit
The problem was that it called Fequal, which can quit. * src/fns.c (enum equal_kind): New enum, to be used in place of a boolean. (equal_no_quit): New function. (Fmemql, Feql): Use it to compare floats, as a minor tuneup. (assoc_no_quit): Use it to avoid quitting, the main point here. (internal_equal): Generalize bool to enum equal_kind arg, so that there are now 3 possibilities instead of 2. Do not signal an error if EQUAL_NO_QUIT. Put the arg before the depth, since depth should be irrelevant if the arg is EQUAL_NO_QUIT. All callers changed.
This commit is contained in:
Paul Eggert
parent
b7ec73f690
commit
080a425db5
1 changed files with 81 additions and 43 deletions
124
src/fns.c
124
src/fns.c
|
|
@ -38,7 +38,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
|||
|
||||
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
|
||||
Lisp_Object *restrict, Lisp_Object *restrict);
|
||||
static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object);
|
||||
static bool equal_no_quit (Lisp_Object, Lisp_Object);
|
||||
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
|
||||
static bool internal_equal (Lisp_Object, Lisp_Object,
|
||||
enum equal_kind, int, Lisp_Object);
|
||||
|
||||
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
|
||||
doc: /* Return the argument unchanged. */
|
||||
|
|
@ -1377,7 +1380,7 @@ The value is actually the tail of LIST whose car is ELT. */)
|
|||
FOR_EACH_TAIL (tail)
|
||||
{
|
||||
Lisp_Object tem = XCAR (tail);
|
||||
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
|
||||
if (FLOATP (tem) && equal_no_quit (elt, tem))
|
||||
return tail;
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
|
|
@ -1428,7 +1431,8 @@ The value is actually the first element of LIST whose car equals KEY. */)
|
|||
}
|
||||
|
||||
/* Like Fassoc but never report an error and do not allow quits.
|
||||
Use only on objects known to be non-circular lists. */
|
||||
Use only on keys and lists known to be non-circular, and on keys
|
||||
that are not too deep and are not window configurations. */
|
||||
|
||||
Lisp_Object
|
||||
assoc_no_quit (Lisp_Object key, Lisp_Object list)
|
||||
|
|
@ -1437,7 +1441,7 @@ assoc_no_quit (Lisp_Object key, Lisp_Object list)
|
|||
{
|
||||
Lisp_Object car = XCAR (list);
|
||||
if (CONSP (car)
|
||||
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
|
||||
&& (EQ (XCAR (car), key) || equal_no_quit (XCAR (car), key)))
|
||||
return car;
|
||||
}
|
||||
return Qnil;
|
||||
|
|
@ -2085,7 +2089,7 @@ Floating-point numbers of equal value are `eql', but they may not be `eq'. */)
|
|||
(Lisp_Object obj1, Lisp_Object obj2)
|
||||
{
|
||||
if (FLOATP (obj1))
|
||||
return internal_equal (obj1, obj2, 0, 0, Qnil) ? Qt : Qnil;
|
||||
return equal_no_quit (obj1, obj2) ? Qt : Qnil;
|
||||
else
|
||||
return EQ (obj1, obj2) ? Qt : Qnil;
|
||||
}
|
||||
|
|
@ -2098,31 +2102,50 @@ Vectors and strings are compared element by element.
|
|||
Numbers are compared by value, but integers cannot equal floats.
|
||||
(Use `=' if you want integers and floats to be able to be equal.)
|
||||
Symbols must match exactly. */)
|
||||
(register Lisp_Object o1, Lisp_Object o2)
|
||||
(Lisp_Object o1, Lisp_Object o2)
|
||||
{
|
||||
return internal_equal (o1, o2, 0, 0, Qnil) ? Qt : Qnil;
|
||||
return internal_equal (o1, o2, EQUAL_PLAIN, 0, Qnil) ? Qt : Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("equal-including-properties", Fequal_including_properties, Sequal_including_properties, 2, 2, 0,
|
||||
doc: /* Return t if two Lisp objects have similar structure and contents.
|
||||
This is like `equal' except that it compares the text properties
|
||||
of strings. (`equal' ignores text properties.) */)
|
||||
(register Lisp_Object o1, Lisp_Object o2)
|
||||
(Lisp_Object o1, Lisp_Object o2)
|
||||
{
|
||||
return internal_equal (o1, o2, 0, 1, Qnil) ? Qt : Qnil;
|
||||
return (internal_equal (o1, o2, EQUAL_INCLUDING_PROPERTIES, 0, Qnil)
|
||||
? Qt : Qnil);
|
||||
}
|
||||
|
||||
/* DEPTH is current depth of recursion. Signal an error if it
|
||||
gets too deep.
|
||||
PROPS means compare string text properties too. */
|
||||
/* Return true if O1 and O2 are equal. Do not quit or check for cycles.
|
||||
Use this only on arguments that are cycle-free and not too large and
|
||||
are not window configurations. */
|
||||
|
||||
static bool
|
||||
internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
||||
Lisp_Object ht)
|
||||
equal_no_quit (Lisp_Object o1, Lisp_Object o2)
|
||||
{
|
||||
return internal_equal (o1, o2, EQUAL_NO_QUIT, 0, Qnil);
|
||||
}
|
||||
|
||||
/* Return true if O1 and O2 are equal. EQUAL_KIND specifies what kind
|
||||
of equality test to use: if it is EQUAL_NO_QUIT, do not check for
|
||||
cycles or large arguments or quits; if EQUAL_PLAIN, do ordinary
|
||||
Lisp equality; and if EQUAL_INCLUDING_PROPERTIES, do
|
||||
equal-including-properties.
|
||||
|
||||
If DEPTH is the current depth of recursion; signal an error if it
|
||||
gets too deep. HT is a hash table used to detect cycles; if nil,
|
||||
it has not been allocated yet. But ignore the last two arguments
|
||||
if EQUAL_KIND == EQUAL_NO_QUIT. */
|
||||
|
||||
static bool
|
||||
internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
|
||||
int depth, Lisp_Object ht)
|
||||
{
|
||||
tail_recurse:
|
||||
if (depth > 10)
|
||||
{
|
||||
eassert (equal_kind != EQUAL_NO_QUIT);
|
||||
if (depth > 200)
|
||||
error ("Stack overflow in equal");
|
||||
if (NILP (ht))
|
||||
|
|
@ -2138,7 +2161,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
{ /* `o1' was seen already. */
|
||||
Lisp_Object o2s = HASH_VALUE (h, i);
|
||||
if (!NILP (Fmemq (o2, o2s)))
|
||||
return 1;
|
||||
return true;
|
||||
else
|
||||
set_hash_value_slot (h, i, Fcons (o2, o2s));
|
||||
}
|
||||
|
|
@ -2150,9 +2173,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
}
|
||||
|
||||
if (EQ (o1, o2))
|
||||
return 1;
|
||||
return true;
|
||||
if (XTYPE (o1) != XTYPE (o2))
|
||||
return 0;
|
||||
return false;
|
||||
|
||||
switch (XTYPE (o1))
|
||||
{
|
||||
|
|
@ -2166,31 +2189,42 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
}
|
||||
|
||||
case Lisp_Cons:
|
||||
{
|
||||
FOR_EACH_TAIL (o1)
|
||||
if (equal_kind == EQUAL_NO_QUIT)
|
||||
for (; CONSP (o1); o1 = XCDR (o1))
|
||||
{
|
||||
if (! CONSP (o2))
|
||||
return false;
|
||||
if (! internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
|
||||
if (! equal_no_quit (XCAR (o1), XCAR (o2)))
|
||||
return false;
|
||||
o2 = XCDR (o2);
|
||||
if (EQ (XCDR (o1), o2))
|
||||
return true;
|
||||
}
|
||||
depth++;
|
||||
goto tail_recurse;
|
||||
}
|
||||
else
|
||||
FOR_EACH_TAIL (o1)
|
||||
{
|
||||
if (! CONSP (o2))
|
||||
return false;
|
||||
if (! internal_equal (XCAR (o1), XCAR (o2),
|
||||
equal_kind, depth + 1, ht))
|
||||
return false;
|
||||
o2 = XCDR (o2);
|
||||
if (EQ (XCDR (o1), o2))
|
||||
return true;
|
||||
}
|
||||
depth++;
|
||||
goto tail_recurse;
|
||||
|
||||
case Lisp_Misc:
|
||||
if (XMISCTYPE (o1) != XMISCTYPE (o2))
|
||||
return 0;
|
||||
return false;
|
||||
if (OVERLAYP (o1))
|
||||
{
|
||||
if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
|
||||
depth + 1, props, ht)
|
||||
equal_kind, depth + 1, ht)
|
||||
|| !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
|
||||
depth + 1, props, ht))
|
||||
return 0;
|
||||
equal_kind, depth + 1, ht))
|
||||
return false;
|
||||
o1 = XOVERLAY (o1)->plist;
|
||||
o2 = XOVERLAY (o2)->plist;
|
||||
depth++;
|
||||
|
|
@ -2212,20 +2246,23 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
actually checks that the objects have the same type as well as the
|
||||
same size. */
|
||||
if (ASIZE (o2) != size)
|
||||
return 0;
|
||||
return false;
|
||||
/* Boolvectors are compared much like strings. */
|
||||
if (BOOL_VECTOR_P (o1))
|
||||
{
|
||||
EMACS_INT size = bool_vector_size (o1);
|
||||
if (size != bool_vector_size (o2))
|
||||
return 0;
|
||||
return false;
|
||||
if (memcmp (bool_vector_data (o1), bool_vector_data (o2),
|
||||
bool_vector_bytes (size)))
|
||||
return 0;
|
||||
return 1;
|
||||
return false;
|
||||
return true;
|
||||
}
|
||||
if (WINDOW_CONFIGURATIONP (o1))
|
||||
return compare_window_configurations (o1, o2, 0);
|
||||
{
|
||||
eassert (equal_kind != EQUAL_NO_QUIT);
|
||||
return compare_window_configurations (o1, o2, false);
|
||||
}
|
||||
|
||||
/* Aside from them, only true vectors, char-tables, compiled
|
||||
functions, and fonts (font-spec, font-entity, font-object)
|
||||
|
|
@ -2234,7 +2271,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
{
|
||||
if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
|
||||
< PVEC_COMPILED)
|
||||
return 0;
|
||||
return false;
|
||||
size &= PSEUDOVECTOR_SIZE_MASK;
|
||||
}
|
||||
for (i = 0; i < size; i++)
|
||||
|
|
@ -2242,29 +2279,30 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
Lisp_Object v1, v2;
|
||||
v1 = AREF (o1, i);
|
||||
v2 = AREF (o2, i);
|
||||
if (!internal_equal (v1, v2, depth + 1, props, ht))
|
||||
return 0;
|
||||
if (!internal_equal (v1, v2, equal_kind, depth + 1, ht))
|
||||
return false;
|
||||
}
|
||||
return 1;
|
||||
return true;
|
||||
}
|
||||
break;
|
||||
|
||||
case Lisp_String:
|
||||
if (SCHARS (o1) != SCHARS (o2))
|
||||
return 0;
|
||||
return false;
|
||||
if (SBYTES (o1) != SBYTES (o2))
|
||||
return 0;
|
||||
return false;
|
||||
if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)))
|
||||
return 0;
|
||||
if (props && !compare_string_intervals (o1, o2))
|
||||
return 0;
|
||||
return 1;
|
||||
return false;
|
||||
if (equal_kind == EQUAL_INCLUDING_PROPERTIES
|
||||
&& !compare_string_intervals (o1, o2))
|
||||
return false;
|
||||
return true;
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
||||
return 0;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue