[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 8227d12 1/2: Fix bug with string values in equal-including-proper
From: |
Stefan Kangas |
Subject: |
master 8227d12 1/2: Fix bug with string values in equal-including-properties |
Date: |
Sat, 30 Oct 2021 22:15:06 -0400 (EDT) |
branch: master
commit 8227d1273e2b82dbed14c0cba06959083d377745
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>
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 efc1825..f7cf1e4 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -92,6 +92,7 @@ Use nil for no limit (caution: backtrace lines can be very
long)."
;;; 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 f88a41f..11d5b6b 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 ? NILP (Fequal (XCAR (i1_val), XCAR (i0_cdr)))
+ : !EQ (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 a18664b..39b7b47 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -715,27 +715,13 @@ This macro is used to test if macroexpansion in `should'
works."
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 3dc2e7b..bec5c03 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -57,6 +57,33 @@
(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))