master 8227d12 1/2: Fix bug with string values in equal-including-properties

[Stefan Kangas]

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))