>From 724af7671590cd91df37f64df6be73f6dca0144d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 7 Jan 2020 11:23:11 -0800 Subject: [PATCH] Fix sxhash-equal on bytecodes, markers, etc. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- doc/lispref/objects.texi | 8 +++++-- doc/lispref/windows.texi | 4 ---- etc/NEWS | 6 +++++ src/fns.c | 52 ++++++++++++++++++++++++---------------- src/lisp.h | 4 ++-- src/window.c | 21 ++++------------ src/window.h | 1 - test/lisp/ffap-tests.el | 2 +- test/src/fns-tests.el | 16 +++++++++++++ 9 files changed, 67 insertions(+), 47 deletions(-) diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 4be2eb6918..4242223a48 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2336,8 +2336,12 @@ Equality Predicates @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 diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index c9301c9d18..d0791d4019 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5915,10 +5915,6 @@ Window Configurations 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 diff --git a/etc/NEWS b/etc/NEWS index d6cabf8e9e..0784160ce2 100644 --- a/etc/NEWS +++ b/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 diff --git a/src/fns.c b/src/fns.c index 4a0a8fd96d..4a463a8feb 100644 --- a/src/fns.c +++ b/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: diff --git a/src/lisp.h b/src/lisp.h index 1a1ae0399b..3681b7b2a7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) 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, diff --git a/src/window.c b/src/window.c index ff17cd88f3..8cdad27b66 100644 --- a/src/window.c +++ b/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 @@ DEFUN ("compare-window-configurations", Fcompare_window_configurations, 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; } diff --git a/src/window.h b/src/window.h index aa8d2c8d1d..167d1be7ab 100644 --- a/src/window.h +++ b/src/window.h @@ -1184,7 +1184,6 @@ #define CHECK_LIVE_WINDOW(WINDOW) \ 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 *); diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index eaf39680e4..30c8f79457 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -74,7 +74,7 @@ ffap-other-window--bug-25352 (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) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 60be2c6c2d..c6ceae4a00 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -858,6 +858,22 @@ test-hash-function-that-mutates-hash-table (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")) -- 2.24.1