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.

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index efc1825017bc6f3310f54c365342f420c6030318..f7cf1e4289ad880cdde6b05934d839f5958680d4 100644 (file)
--- 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 f88a41f254917c93e7f39a47f0e7c49cc5d2ad0d..11d5b6bbb6f8066d0cd003c821ea1eea733b7f2d 100644 (file)
--- 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);
+}
 \f
 
 /* 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 a18664bba3bac1f5f6edc115e6b7611fca1908de..39b7b475555859ec690b807899eb4283f6ad38ec 100644 (file)
--- 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 3dc2e7b3ec8513c2516980e8f79a8be4bccb47b8..bec5c03f9e7af85d7b5964e085489bf9b3b8fca3 100644 (file)
--- 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))