aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2020-01-07 11:23:11 -0800
committerPaul Eggert2020-01-07 11:29:42 -0800
commit724af7671590cd91df37f64df6be73f6dca0144d (patch)
tree075df63dcdc3653ff710ce49a5f238c165d0f0c1
parentf950b078a6f2fd011312e9471998edf6b5fb957e (diff)
downloademacs-724af7671590cd91df37f64df6be73f6dca0144d.tar.gz
emacs-724af7671590cd91df37f64df6be73f6dca0144d.zip
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.
-rw-r--r--doc/lispref/objects.texi8
-rw-r--r--doc/lispref/windows.texi4
-rw-r--r--etc/NEWS6
-rw-r--r--src/fns.c52
-rw-r--r--src/lisp.h4
-rw-r--r--src/window.c21
-rw-r--r--src/window.h1
-rw-r--r--test/lisp/ffap-tests.el2
-rw-r--r--test/src/fns-tests.el16
9 files changed, 67 insertions, 47 deletions
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 4be2eb6918b..4242223a48e 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2336,8 +2336,12 @@ same sequence of character codes and all these codes are in the range
2336@end group 2336@end group
2337@end example 2337@end example
2338 2338
2339However, two distinct buffers are never considered @code{equal}, even if 2339The @code{equal} function recursively compares the contents of objects
2340their textual contents are the same. 2340if they are integers, strings, markers, vectors, bool-vectors,
2341byte-code function objects, char-tables, records, or font objects.
2342Other objects are considered @code{equal} only if they are @code{eq}.
2343For example, two distinct buffers are never considered @code{equal},
2344even if their textual contents are the same.
2341@end defun 2345@end defun
2342 2346
2343 For @code{equal}, equality is defined recursively; for example, given 2347 For @code{equal}, equality is defined recursively; for example, given
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index c9301c9d186..d0791d40196 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -5915,10 +5915,6 @@ This function compares two window configurations as regards the
5915structure of windows, but ignores the values of point and the 5915structure of windows, but ignores the values of point and the
5916saved scrolling positions---it can return @code{t} even if those 5916saved scrolling positions---it can return @code{t} even if those
5917aspects differ. 5917aspects differ.
5918
5919The function @code{equal} can also compare two window configurations; it
5920regards configurations as unequal if they differ in any respect, even a
5921saved point.
5922@end defun 5918@end defun
5923 5919
5924@defun window-configuration-frame config 5920@defun window-configuration-frame config
diff --git a/etc/NEWS b/etc/NEWS
index d6cabf8e9e4..0784160ce22 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -42,6 +42,12 @@ applies, and please also update docstrings as needed.
42 42
43* Incompatible Lisp Changes in Emacs 28.1 43* Incompatible Lisp Changes in Emacs 28.1
44 44
45** 'equal' no longer examines some contents of window configurations.
46Instead, it considers window configurations to be equal only if they
47are eq. To compare contents, use compare-window-configurations
48instead. This change helps fix a bug in sxhash-equal, which returned
49incorrect hashes for window configurations and some other objects.
50
45 51
46* Lisp Changes in Emacs 28.1 52* Lisp Changes in Emacs 28.1
47 53
diff --git a/src/fns.c b/src/fns.c
index 4a0a8fd96d8..4a463a8feb2 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,
2434 same size. */ 2434 same size. */
2435 if (ASIZE (o2) != size) 2435 if (ASIZE (o2) != size)
2436 return false; 2436 return false;
2437
2438 /* Compare bignums, overlays, markers, and boolvectors
2439 specially, by comparing their values. */
2437 if (BIGNUMP (o1)) 2440 if (BIGNUMP (o1))
2438 return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0; 2441 return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
2439 if (OVERLAYP (o1)) 2442 if (OVERLAYP (o1))
@@ -2454,7 +2457,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2454 && (XMARKER (o1)->buffer == 0 2457 && (XMARKER (o1)->buffer == 0
2455 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); 2458 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
2456 } 2459 }
2457 /* Boolvectors are compared much like strings. */
2458 if (BOOL_VECTOR_P (o1)) 2460 if (BOOL_VECTOR_P (o1))
2459 { 2461 {
2460 EMACS_INT size = bool_vector_size (o1); 2462 EMACS_INT size = bool_vector_size (o1);
@@ -2465,11 +2467,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2465 return false; 2467 return false;
2466 return true; 2468 return true;
2467 } 2469 }
2468 if (WINDOW_CONFIGURATIONP (o1))
2469 {
2470 eassert (equal_kind != EQUAL_NO_QUIT);
2471 return compare_window_configurations (o1, o2, false);
2472 }
2473 2470
2474 /* Aside from them, only true vectors, char-tables, compiled 2471 /* Aside from them, only true vectors, char-tables, compiled
2475 functions, and fonts (font-spec, font-entity, font-object) 2472 functions, and fonts (font-spec, font-entity, font-object)
@@ -4703,22 +4700,35 @@ sxhash_obj (Lisp_Object obj, int depth)
4703 hash = sxhash_string (SSDATA (obj), SBYTES (obj)); 4700 hash = sxhash_string (SSDATA (obj), SBYTES (obj));
4704 break; 4701 break;
4705 4702
4706 /* This can be everything from a vector to an overlay. */
4707 case Lisp_Vectorlike: 4703 case Lisp_Vectorlike:
4708 if (BIGNUMP (obj)) 4704 {
4709 hash = sxhash_bignum (obj); 4705 enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
4710 else if (VECTORP (obj) || RECORDP (obj)) 4706 if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
4711 /* According to the CL HyperSpec, two arrays are equal only if 4707 {
4712 they are `eq', except for strings and bit-vectors. In 4708 /* According to the CL HyperSpec, two arrays are equal only if
4713 Emacs, this works differently. We have to compare element 4709 they are 'eq', except for strings and bit-vectors. In
4714 by element. Same for records. */ 4710 Emacs, this works differently. We have to compare element
4715 hash = sxhash_vector (obj, depth); 4711 by element. Same for pseudovectors that internal_equal
4716 else if (BOOL_VECTOR_P (obj)) 4712 examines the Lisp contents of. */
4717 hash = sxhash_bool_vector (obj); 4713 hash = sxhash_vector (obj, depth);
4718 else 4714 break;
4719 /* Others are `equal' if they are `eq', so let's take their 4715 }
4720 address as hash. */ 4716 else if (pvec_type == PVEC_BIGNUM)
4721 hash = XHASH (obj); 4717 hash = sxhash_bignum (obj);
4718 else if (pvec_type == PVEC_MARKER)
4719 {
4720 ptrdiff_t bytepos
4721 = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
4722 hash = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
4723 hash = SXHASH_REDUCE (hash);
4724 }
4725 else if (pvec_type == PVEC_BOOL_VECTOR)
4726 hash = sxhash_bool_vector (obj);
4727 else
4728 /* Others are 'equal' if they are 'eq', so take their
4729 address as hash. */
4730 hash = XHASH (obj);
4731 }
4722 break; 4732 break;
4723 4733
4724 case Lisp_Cons: 4734 case Lisp_Cons:
diff --git a/src/lisp.h b/src/lisp.h
index 1a1ae0399be..3681b7b2a7c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1069,7 +1069,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
1069 with PVEC_TYPE_MASK to indicate the actual type. */ 1069 with PVEC_TYPE_MASK to indicate the actual type. */
1070enum pvec_type 1070enum pvec_type
1071{ 1071{
1072 PVEC_NORMAL_VECTOR, 1072 PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */
1073 PVEC_FREE, 1073 PVEC_FREE,
1074 PVEC_BIGNUM, 1074 PVEC_BIGNUM,
1075 PVEC_MARKER, 1075 PVEC_MARKER,
@@ -1094,7 +1094,7 @@ enum pvec_type
1094 PVEC_CONDVAR, 1094 PVEC_CONDVAR,
1095 PVEC_MODULE_FUNCTION, 1095 PVEC_MODULE_FUNCTION,
1096 1096
1097 /* These should be last, check internal_equal to see why. */ 1097 /* These should be last, for internal_equal and sxhash_obj. */
1098 PVEC_COMPILED, 1098 PVEC_COMPILED,
1099 PVEC_CHAR_TABLE, 1099 PVEC_CHAR_TABLE,
1100 PVEC_SUB_CHAR_TABLE, 1100 PVEC_SUB_CHAR_TABLE,
diff --git a/src/window.c b/src/window.c
index ff17cd88f38..8cdad27b664 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7976,19 +7976,17 @@ foreach_window_1 (struct window *w, bool (*fn) (struct window *, void *),
7976/* Return true if window configurations CONFIGURATION1 and CONFIGURATION2 7976/* Return true if window configurations CONFIGURATION1 and CONFIGURATION2
7977 describe the same state of affairs. This is used by Fequal. 7977 describe the same state of affairs. This is used by Fequal.
7978 7978
7979 IGNORE_POSITIONS means ignore non-matching scroll positions 7979 Ignore non-matching scroll positions and the like.
7980 and the like.
7981 7980
7982 This ignores a couple of things like the dedication status of 7981 This ignores a couple of things like the dedication status of
7983 window, combination_limit and the like. This might have to be 7982 window, combination_limit and the like. This might have to be
7984 fixed. */ 7983 fixed. */
7985 7984
7986bool 7985static bool
7987compare_window_configurations (Lisp_Object configuration1, 7986compare_window_configurations (Lisp_Object configuration1,
7988 Lisp_Object configuration2, 7987 Lisp_Object configuration2)
7989 bool ignore_positions)
7990{ 7988{
7991 register struct save_window_data *d1, *d2; 7989 struct save_window_data *d1, *d2;
7992 struct Lisp_Vector *sws1, *sws2; 7990 struct Lisp_Vector *sws1, *sws2;
7993 ptrdiff_t i; 7991 ptrdiff_t i;
7994 7992
@@ -8006,9 +8004,6 @@ compare_window_configurations (Lisp_Object configuration1,
8006 || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines 8004 || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
8007 || !EQ (d1->selected_frame, d2->selected_frame) 8005 || !EQ (d1->selected_frame, d2->selected_frame)
8008 || !EQ (d1->f_current_buffer, d2->f_current_buffer) 8006 || !EQ (d1->f_current_buffer, d2->f_current_buffer)
8009 || (!ignore_positions
8010 && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
8011 || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
8012 || !EQ (d1->focus_frame, d2->focus_frame) 8007 || !EQ (d1->focus_frame, d2->focus_frame)
8013 /* Verify that the two configurations have the same number of windows. */ 8008 /* Verify that the two configurations have the same number of windows. */
8014 || sws1->header.size != sws2->header.size) 8009 || sws1->header.size != sws2->header.size)
@@ -8041,12 +8036,6 @@ compare_window_configurations (Lisp_Object configuration1,
8041 equality. */ 8036 equality. */
8042 || !EQ (sw1->parent, sw2->parent) 8037 || !EQ (sw1->parent, sw2->parent)
8043 || !EQ (sw1->prev, sw2->prev) 8038 || !EQ (sw1->prev, sw2->prev)
8044 || (!ignore_positions
8045 && (!EQ (sw1->hscroll, sw2->hscroll)
8046 || !EQ (sw1->min_hscroll, sw2->min_hscroll)
8047 || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg)
8048 || NILP (Fequal (sw1->start, sw2->start))
8049 || NILP (Fequal (sw1->pointm, sw2->pointm))))
8050 || !EQ (sw1->left_margin_cols, sw2->left_margin_cols) 8039 || !EQ (sw1->left_margin_cols, sw2->left_margin_cols)
8051 || !EQ (sw1->right_margin_cols, sw2->right_margin_cols) 8040 || !EQ (sw1->right_margin_cols, sw2->right_margin_cols)
8052 || !EQ (sw1->left_fringe_width, sw2->left_fringe_width) 8041 || !EQ (sw1->left_fringe_width, sw2->left_fringe_width)
@@ -8071,7 +8060,7 @@ This function ignores details such as the values of point
8071and scrolling positions. */) 8060and scrolling positions. */)
8072 (Lisp_Object x, Lisp_Object y) 8061 (Lisp_Object x, Lisp_Object y)
8073{ 8062{
8074 if (compare_window_configurations (x, y, true)) 8063 if (compare_window_configurations (x, y))
8075 return Qt; 8064 return Qt;
8076 return Qnil; 8065 return Qnil;
8077} 8066}
diff --git a/src/window.h b/src/window.h
index aa8d2c8d1d2..167d1be7abb 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1184,7 +1184,6 @@ extern Lisp_Object window_list (void);
1184extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter); 1184extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
1185extern struct window *decode_live_window (Lisp_Object); 1185extern struct window *decode_live_window (Lisp_Object);
1186extern struct window *decode_any_window (Lisp_Object); 1186extern struct window *decode_any_window (Lisp_Object);
1187extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
1188extern void mark_window_cursors_off (struct window *); 1187extern void mark_window_cursors_off (struct window *);
1189extern bool window_wants_mode_line (struct window *); 1188extern bool window_wants_mode_line (struct window *);
1190extern bool window_wants_header_line (struct window *); 1189extern bool window_wants_header_line (struct window *);
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index eaf39680e48..30c8f794577 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -74,7 +74,7 @@ left alone when opening a URL in an external browser."
74 (urls nil) 74 (urls nil)
75 (ffap-url-fetcher (lambda (url) (push url urls) nil))) 75 (ffap-url-fetcher (lambda (url) (push url urls) nil)))
76 (should-not (ffap-other-window "https://www.gnu.org")) 76 (should-not (ffap-other-window "https://www.gnu.org"))
77 (should (equal (current-window-configuration) old)) 77 (should (compare-window-configurations (current-window-configuration) old))
78 (should (equal urls '("https://www.gnu.org"))))) 78 (should (equal urls '("https://www.gnu.org")))))
79 79
80(provide 'ffap-tests) 80(provide 'ffap-tests)
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 60be2c6c2d7..c6ceae4a00e 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -858,6 +858,22 @@
858 (puthash k k h))) 858 (puthash k k h)))
859 (should (= 100 (hash-table-count h))))) 859 (should (= 100 (hash-table-count h)))))
860 860
861(ert-deftest test-sxhash-equal ()
862 (should (= (sxhash-equal (* most-positive-fixnum most-negative-fixnum))
863 (sxhash-equal (* most-positive-fixnum most-negative-fixnum))))
864 (should (= (sxhash-equal (make-string 1000 ?a))
865 (sxhash-equal (make-string 1000 ?a))))
866 (should (= (sxhash-equal (point-marker))
867 (sxhash-equal (point-marker))))
868 (should (= (sxhash-equal (make-vector 1000 (make-string 10 ?a)))
869 (sxhash-equal (make-vector 1000 (make-string 10 ?a)))))
870 (should (= (sxhash-equal (make-bool-vector 1000 t))
871 (sxhash-equal (make-bool-vector 1000 t))))
872 (should (= (sxhash-equal (make-char-table nil (make-string 10 ?a)))
873 (sxhash-equal (make-char-table nil (make-string 10 ?a)))))
874 (should (= (sxhash-equal (record 'a (make-string 10 ?a)))
875 (sxhash-equal (record 'a (make-string 10 ?a))))))
876
861(ert-deftest test-secure-hash () 877(ert-deftest test-secure-hash ()
862 (should (equal (secure-hash 'md5 "foobar") 878 (should (equal (secure-hash 'md5 "foobar")
863 "3858f62230ac3c915f300c664312c63f")) 879 "3858f62230ac3c915f300c664312c63f"))