From 316ce9b0fbbf34c26cc4d7701c3780914adb505b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 20 Oct 2021 14:16:07 +0200 Subject: [PATCH 1/2] Fix bug with string values in equal-including-properties * src/intervals.c (intervals_equal_1): Factor out from intervals_equal. Optionally use Fequal for comparison of string values in property lists. (intervals_equal): Update for the above. (compare_string_intervals): Use the above optional Fequal comparison to fix a bug where 'equal-including-properties' compared strings with eq, instead of equal. (Bug#6581) * test/src/fns-tests.el (fns-tests-equal-including-properties) (fns-tests-equal-including-properties/string-prop-vals): New tests. * test/lisp/emacs-lisp/ert-tests.el (ert-test-equal-including-properties): Remove parts testing 'equal-including-properties'. * lisp/emacs-lisp/ert.el (ert-equal-including-properties): Add FIXME that this should be removed. --- lisp/emacs-lisp/ert.el | 1 + src/intervals.c | 20 +++++++++++++++----- test/lisp/emacs-lisp/ert-tests.el | 14 -------------- test/src/fns-tests.el | 27 +++++++++++++++++++++++++++ 4 files changed, 43 insertions(+), 19 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 57655403c2..a5b5258c3e 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -92,6 +92,7 @@ ert-test-result-unexpected ;;; Copies/reimplementations of cl functions. +;; FIXME: Bug#6581 is fixed, so this should be deleted. (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. diff --git a/src/intervals.c b/src/intervals.c index f88a41f254..15bdc5b517 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -166,10 +166,11 @@ merge_properties (register INTERVAL source, register INTERVAL target) } } -/* Return true if the two intervals have the same properties. */ +/* Return true if the two intervals have the same properties. + If use_equal is true, use Fequal for comparisons instead of EQ. */ -bool -intervals_equal (INTERVAL i0, INTERVAL i1) +static bool +intervals_equal_1 (INTERVAL i0, INTERVAL i1, bool use_equal) { Lisp_Object i0_cdr, i0_sym; Lisp_Object i1_cdr, i1_val; @@ -204,7 +205,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* i0 and i1 both have sym, but it has different values in each. */ if (!CONSP (i1_val) || (i1_val = XCDR (i1_val), !CONSP (i1_val)) - || !EQ (XCAR (i1_val), XCAR (i0_cdr))) + || (!use_equal && !EQ (XCAR (i1_val), XCAR (i0_cdr))) + || (use_equal && NILP (Fequal (XCAR (i1_val), XCAR (i0_cdr))))) return false; i0_cdr = XCDR (i0_cdr); @@ -218,6 +220,14 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* Lengths of the two plists were equal. */ return (NILP (i0_cdr) && NILP (i1_cdr)); } + +/* Return true if the two intervals have the same properties. */ + +bool +intervals_equal (INTERVAL i0, INTERVAL i1) +{ + return intervals_equal_1 (i0, i1, false); +} /* Traverse an interval tree TREE, performing FUNCTION on each node. @@ -2291,7 +2301,7 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2) /* If we ever find a mismatch between the strings, they differ. */ - if (! intervals_equal (i1, i2)) + if (! intervals_equal_1 (i1, i2, true)) return 0; /* Advance POS till the end of the shorter interval, diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index a18664bba3..39b7b47555 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -715,27 +715,13 @@ ert-test-explain-equal-string-properties context-before "f" context-after "o")))) (ert-deftest ert-test-equal-including-properties () - (should (equal-including-properties "foo" "foo")) (should (ert-equal-including-properties "foo" "foo")) - - (should (equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) (should (ert-equal-including-properties #("foo" 0 3 (a b)) (propertize "foo" 'a 'b))) - - (should (equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) (propertize "foo" 'a 'b 'c 'd))) - - (should-not (equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) (propertize "foo" 'a 'b 'c 'd))) - - ;; This is bug 6581. - (should-not (equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t)))) (should (ert-equal-including-properties #("foo" 0 3 (a (t))) (propertize "foo" 'a (list t))))) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3dc2e7b3ec..bec5c03f9e 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -57,6 +57,33 @@ fns-tests-equality-nan (puthash nan t h) (should (eq (funcall test nan -nan) (gethash -nan h)))))) +(ert-deftest fns-tests-equal-including-properties () + (should (equal-including-properties "" "")) + (should (equal-including-properties "foo" "foo")) + (should (equal-including-properties #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should (equal-including-properties #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should (equal-including-properties #("a" 0 1 (k v)) + #("a" 0 1 (k v)))) + (should-not (equal-including-properties #("a" 0 1 (k v)) + #("a" 0 1 (k x)))) + (should-not (equal-including-properties #("a" 0 1 (k v)) + #("b" 0 1 (k v)))) + (should-not (equal-including-properties #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)))) + +(ert-deftest fns-tests-equal-including-properties/string-prop-vals () + "Handle string property values. (Bug#6581)" + (should (equal-including-properties #("a" 0 1 (k "v")) + #("a" 0 1 (k "v")))) + (should (equal-including-properties #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + (should-not (equal-including-properties #("a" 0 1 (k "v")) + #("a" 0 1 (k "x")))) + (should-not (equal-including-properties #("a" 0 1 (k "v")) + #("b" 0 1 (k "v"))))) + (ert-deftest fns-tests-reverse () (should-error (reverse)) (should-error (reverse 1)) -- 2.30.2