From 52cb8610cc4805be89ecf77285d9e6d1efaf9364 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 20 Oct 2021 14:16:07 +0200 Subject: [PATCH] Fix bug with string values in equal-including-properties * src/intervals.c (intervals_equal_1): Factor out from intervals_equal. Use Fequal for comparison if third argument use_equal is true. This fixes a bug with string values in property lists compared with 'equal-including-properties'. (Bug#6581) (intervals_equal): Update for the above. (compare_string_intervals): Call intervals_equal1 with third argument as true. * src/intervals.h (intervals_equal_1): Declare. * test/src/fns-tests.el (fns-tests-equal-including-properties) (fns-tests-equal-including-properties/string-prop-vals): New tests. --- src/intervals.c | 18 ++++++++++++++---- src/intervals.h | 1 + test/src/fns-tests.el | 19 +++++++++++++++++++ 3 files changed, 34 insertions(+), 4 deletions(-) diff --git a/src/intervals.c b/src/intervals.c index f88a41f254..cef5d9a4d7 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) +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/src/intervals.h b/src/intervals.h index c1b19345d2..4096dc02fd 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -243,6 +243,7 @@ #define TEXT_PROP_MEANS_INVISIBLE(prop) \ extern INTERVAL create_root_interval (Lisp_Object); extern void copy_properties (INTERVAL, INTERVAL); +bool intervals_equal_1 (INTERVAL, INTERVAL, bool); extern bool intervals_equal (INTERVAL, INTERVAL); extern void traverse_intervals (INTERVAL, ptrdiff_t, void (*) (INTERVAL, Lisp_Object), diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3dc2e7b3ec..b4cb3c131a 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -57,6 +57,25 @@ 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 "foobar" "foobar")) + (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))))) + +(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-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