Fix sxhash-equal on bytecodes, markers, etc.
Problem reported by Pip Cet (Bug#38912#14). * doc/lispref/objects.texi (Equality Predicates): Document better when ‘equal’ looks inside objects. * doc/lispref/windows.texi (Window Configurations): Don’t say that ‘equal’ looks inside window configurations. * etc/NEWS: Mention the change. * src/fns.c (internal_equal): Do not look inside window configurations. (sxhash_obj): Hash markers, byte-code function objects, char-tables, and font objects consistently with Fequal. * src/window.c (compare_window_configurations): Now static. Remove last argument. Caller changed. * test/lisp/ffap-tests.el (ffap-other-window--bug-25352): Use compare-window-configurations, not ‘equal’. * test/src/fns-tests.el (test-sxhash-equal): New test.
This commit is contained in:
parent
f950b078a6
commit
724af76715
9 changed files with 67 additions and 47 deletions
|
@ -2336,8 +2336,12 @@ same sequence of character codes and all these codes are in the range
|
|||
@end group
|
||||
@end example
|
||||
|
||||
However, two distinct buffers are never considered @code{equal}, even if
|
||||
their textual contents are the same.
|
||||
The @code{equal} function recursively compares the contents of objects
|
||||
if they are integers, strings, markers, vectors, bool-vectors,
|
||||
byte-code function objects, char-tables, records, or font objects.
|
||||
Other objects are considered @code{equal} only if they are @code{eq}.
|
||||
For example, two distinct buffers are never considered @code{equal},
|
||||
even if their textual contents are the same.
|
||||
@end defun
|
||||
|
||||
For @code{equal}, equality is defined recursively; for example, given
|
||||
|
|
|
@ -5915,10 +5915,6 @@ This function compares two window configurations as regards the
|
|||
structure of windows, but ignores the values of point and the
|
||||
saved scrolling positions---it can return @code{t} even if those
|
||||
aspects differ.
|
||||
|
||||
The function @code{equal} can also compare two window configurations; it
|
||||
regards configurations as unequal if they differ in any respect, even a
|
||||
saved point.
|
||||
@end defun
|
||||
|
||||
@defun window-configuration-frame config
|
||||
|
|
6
etc/NEWS
6
etc/NEWS
|
@ -42,6 +42,12 @@ applies, and please also update docstrings as needed.
|
|||
|
||||
* Incompatible Lisp Changes in Emacs 28.1
|
||||
|
||||
** 'equal' no longer examines some contents of window configurations.
|
||||
Instead, it considers window configurations to be equal only if they
|
||||
are eq. To compare contents, use compare-window-configurations
|
||||
instead. This change helps fix a bug in sxhash-equal, which returned
|
||||
incorrect hashes for window configurations and some other objects.
|
||||
|
||||
|
||||
* Lisp Changes in Emacs 28.1
|
||||
|
||||
|
|
52
src/fns.c
52
src/fns.c
|
@ -2434,6 +2434,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
|
|||
same size. */
|
||||
if (ASIZE (o2) != size)
|
||||
return false;
|
||||
|
||||
/* Compare bignums, overlays, markers, and boolvectors
|
||||
specially, by comparing their values. */
|
||||
if (BIGNUMP (o1))
|
||||
return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
|
||||
if (OVERLAYP (o1))
|
||||
|
@ -2454,7 +2457,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
|
|||
&& (XMARKER (o1)->buffer == 0
|
||||
|| XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
|
||||
}
|
||||
/* Boolvectors are compared much like strings. */
|
||||
if (BOOL_VECTOR_P (o1))
|
||||
{
|
||||
EMACS_INT size = bool_vector_size (o1);
|
||||
|
@ -2465,11 +2467,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
|
|||
return false;
|
||||
return true;
|
||||
}
|
||||
if (WINDOW_CONFIGURATIONP (o1))
|
||||
{
|
||||
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)
|
||||
|
@ -4703,22 +4700,35 @@ sxhash_obj (Lisp_Object obj, int depth)
|
|||
hash = sxhash_string (SSDATA (obj), SBYTES (obj));
|
||||
break;
|
||||
|
||||
/* This can be everything from a vector to an overlay. */
|
||||
case Lisp_Vectorlike:
|
||||
if (BIGNUMP (obj))
|
||||
hash = sxhash_bignum (obj);
|
||||
else if (VECTORP (obj) || RECORDP (obj))
|
||||
/* According to the CL HyperSpec, two arrays are equal only if
|
||||
they are `eq', except for strings and bit-vectors. In
|
||||
Emacs, this works differently. We have to compare element
|
||||
by element. Same for records. */
|
||||
hash = sxhash_vector (obj, depth);
|
||||
else if (BOOL_VECTOR_P (obj))
|
||||
hash = sxhash_bool_vector (obj);
|
||||
else
|
||||
/* Others are `equal' if they are `eq', so let's take their
|
||||
address as hash. */
|
||||
hash = XHASH (obj);
|
||||
{
|
||||
enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
|
||||
if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
|
||||
{
|
||||
/* According to the CL HyperSpec, two arrays are equal only if
|
||||
they are 'eq', except for strings and bit-vectors. In
|
||||
Emacs, this works differently. We have to compare element
|
||||
by element. Same for pseudovectors that internal_equal
|
||||
examines the Lisp contents of. */
|
||||
hash = sxhash_vector (obj, depth);
|
||||
break;
|
||||
}
|
||||
else if (pvec_type == PVEC_BIGNUM)
|
||||
hash = sxhash_bignum (obj);
|
||||
else if (pvec_type == PVEC_MARKER)
|
||||
{
|
||||
ptrdiff_t bytepos
|
||||
= XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
|
||||
hash = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
|
||||
hash = SXHASH_REDUCE (hash);
|
||||
}
|
||||
else if (pvec_type == PVEC_BOOL_VECTOR)
|
||||
hash = sxhash_bool_vector (obj);
|
||||
else
|
||||
/* Others are 'equal' if they are 'eq', so take their
|
||||
address as hash. */
|
||||
hash = XHASH (obj);
|
||||
}
|
||||
break;
|
||||
|
||||
case Lisp_Cons:
|
||||
|
|
|
@ -1069,7 +1069,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
|
|||
with PVEC_TYPE_MASK to indicate the actual type. */
|
||||
enum pvec_type
|
||||
{
|
||||
PVEC_NORMAL_VECTOR,
|
||||
PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */
|
||||
PVEC_FREE,
|
||||
PVEC_BIGNUM,
|
||||
PVEC_MARKER,
|
||||
|
@ -1094,7 +1094,7 @@ enum pvec_type
|
|||
PVEC_CONDVAR,
|
||||
PVEC_MODULE_FUNCTION,
|
||||
|
||||
/* These should be last, check internal_equal to see why. */
|
||||
/* These should be last, for internal_equal and sxhash_obj. */
|
||||
PVEC_COMPILED,
|
||||
PVEC_CHAR_TABLE,
|
||||
PVEC_SUB_CHAR_TABLE,
|
||||
|
|
21
src/window.c
21
src/window.c
|
@ -7976,19 +7976,17 @@ foreach_window_1 (struct window *w, bool (*fn) (struct window *, void *),
|
|||
/* Return true if window configurations CONFIGURATION1 and CONFIGURATION2
|
||||
describe the same state of affairs. This is used by Fequal.
|
||||
|
||||
IGNORE_POSITIONS means ignore non-matching scroll positions
|
||||
and the like.
|
||||
Ignore non-matching scroll positions and the like.
|
||||
|
||||
This ignores a couple of things like the dedication status of
|
||||
window, combination_limit and the like. This might have to be
|
||||
fixed. */
|
||||
|
||||
bool
|
||||
static bool
|
||||
compare_window_configurations (Lisp_Object configuration1,
|
||||
Lisp_Object configuration2,
|
||||
bool ignore_positions)
|
||||
Lisp_Object configuration2)
|
||||
{
|
||||
register struct save_window_data *d1, *d2;
|
||||
struct save_window_data *d1, *d2;
|
||||
struct Lisp_Vector *sws1, *sws2;
|
||||
ptrdiff_t i;
|
||||
|
||||
|
@ -8006,9 +8004,6 @@ compare_window_configurations (Lisp_Object configuration1,
|
|||
|| d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
|
||||
|| !EQ (d1->selected_frame, d2->selected_frame)
|
||||
|| !EQ (d1->f_current_buffer, d2->f_current_buffer)
|
||||
|| (!ignore_positions
|
||||
&& (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
|
||||
|| !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
|
||||
|| !EQ (d1->focus_frame, d2->focus_frame)
|
||||
/* Verify that the two configurations have the same number of windows. */
|
||||
|| sws1->header.size != sws2->header.size)
|
||||
|
@ -8041,12 +8036,6 @@ compare_window_configurations (Lisp_Object configuration1,
|
|||
equality. */
|
||||
|| !EQ (sw1->parent, sw2->parent)
|
||||
|| !EQ (sw1->prev, sw2->prev)
|
||||
|| (!ignore_positions
|
||||
&& (!EQ (sw1->hscroll, sw2->hscroll)
|
||||
|| !EQ (sw1->min_hscroll, sw2->min_hscroll)
|
||||
|| !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg)
|
||||
|| NILP (Fequal (sw1->start, sw2->start))
|
||||
|| NILP (Fequal (sw1->pointm, sw2->pointm))))
|
||||
|| !EQ (sw1->left_margin_cols, sw2->left_margin_cols)
|
||||
|| !EQ (sw1->right_margin_cols, sw2->right_margin_cols)
|
||||
|| !EQ (sw1->left_fringe_width, sw2->left_fringe_width)
|
||||
|
@ -8071,7 +8060,7 @@ This function ignores details such as the values of point
|
|||
and scrolling positions. */)
|
||||
(Lisp_Object x, Lisp_Object y)
|
||||
{
|
||||
if (compare_window_configurations (x, y, true))
|
||||
if (compare_window_configurations (x, y))
|
||||
return Qt;
|
||||
return Qnil;
|
||||
}
|
||||
|
|
|
@ -1184,7 +1184,6 @@ extern Lisp_Object window_list (void);
|
|||
extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
|
||||
extern struct window *decode_live_window (Lisp_Object);
|
||||
extern struct window *decode_any_window (Lisp_Object);
|
||||
extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
|
||||
extern void mark_window_cursors_off (struct window *);
|
||||
extern bool window_wants_mode_line (struct window *);
|
||||
extern bool window_wants_header_line (struct window *);
|
||||
|
|
|
@ -74,7 +74,7 @@ left alone when opening a URL in an external browser."
|
|||
(urls nil)
|
||||
(ffap-url-fetcher (lambda (url) (push url urls) nil)))
|
||||
(should-not (ffap-other-window "https://www.gnu.org"))
|
||||
(should (equal (current-window-configuration) old))
|
||||
(should (compare-window-configurations (current-window-configuration) old))
|
||||
(should (equal urls '("https://www.gnu.org")))))
|
||||
|
||||
(provide 'ffap-tests)
|
||||
|
|
|
@ -858,6 +858,22 @@
|
|||
(puthash k k h)))
|
||||
(should (= 100 (hash-table-count h)))))
|
||||
|
||||
(ert-deftest test-sxhash-equal ()
|
||||
(should (= (sxhash-equal (* most-positive-fixnum most-negative-fixnum))
|
||||
(sxhash-equal (* most-positive-fixnum most-negative-fixnum))))
|
||||
(should (= (sxhash-equal (make-string 1000 ?a))
|
||||
(sxhash-equal (make-string 1000 ?a))))
|
||||
(should (= (sxhash-equal (point-marker))
|
||||
(sxhash-equal (point-marker))))
|
||||
(should (= (sxhash-equal (make-vector 1000 (make-string 10 ?a)))
|
||||
(sxhash-equal (make-vector 1000 (make-string 10 ?a)))))
|
||||
(should (= (sxhash-equal (make-bool-vector 1000 t))
|
||||
(sxhash-equal (make-bool-vector 1000 t))))
|
||||
(should (= (sxhash-equal (make-char-table nil (make-string 10 ?a)))
|
||||
(sxhash-equal (make-char-table nil (make-string 10 ?a)))))
|
||||
(should (= (sxhash-equal (record 'a (make-string 10 ?a)))
|
||||
(sxhash-equal (record 'a (make-string 10 ?a))))))
|
||||
|
||||
(ert-deftest test-secure-hash ()
|
||||
(should (equal (secure-hash 'md5 "foobar")
|
||||
"3858f62230ac3c915f300c664312c63f"))
|
||||
|
|
Loading…
Add table
Reference in a new issue