bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

[Pip Cet]

[-- Attachment #1: Type: text/plain, Size: 689 bytes --]

plist-get currently contains this code:

  FOR_EACH_TAIL_SAFE (tail)
    {
      <check for success>
      tail = XCDR (tail);
      if (EQ (tail, li.tortoise))
        break;
    }

I don't understand why the last two lines are there. They're
unnecessary for proper plists; for circular plists, they result in
unintuitive behavior; and they depend on details of the
FOR_EACH_TAIL_SAFE implementation.

Can someone enlighten me?

As a tangential issue, shouldn't `equal' be symmetric?

(let* ((l1 '#1=(0 1 2 . #1#))
       (l2 '(0 1 2 0 1 2 . #1#)))
  (equal l2 l1) => t
  (equal l1 l2) => "List contains a loop" error.
  (plist-get l2 1) => 2
  (plist-get l1 1) => nil

Patches attached.

[-- Attachment #2: 0001-Remove-unnecessary-tortoise-checks.patch --]
[-- Type: text/x-patch, Size: 2326 bytes --]

From 722b621835b1470f420ad9610f80f50f4b31a5c6 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Thu, 27 Jun 2019 20:11:52 +0000
Subject: [PATCH] Remove unnecessary tortoise checks.

* src/fns.c (Fplist_get, Fplist_put, Flax_plist_get)
(Flax_plist_put, Fplist_member): Remove unnecessary check.
* src/json.c (lisp_to_json_toplevel_1): Remove unnecessary check.
---
 src/fns.c  | 10 ----------
 src/json.c |  1 -
 2 files changed, 11 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index fd0c7fc71a..2fc000a7f4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2164,8 +2164,6 @@ DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
       if (EQ (prop, XCAR (tail)))
 	return XCAR (XCDR (tail));
       tail = XCDR (tail);
-      if (EQ (tail, li.tortoise))
-	break;
     }
 
   return Qnil;
@@ -2208,8 +2206,6 @@ DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
 
       prev = tail;
       tail = XCDR (tail);
-      if (EQ (tail, li.tortoise))
-	circular_list (plist);
     }
   CHECK_TYPE (NILP (tail), Qplistp, plist);
   Lisp_Object newcell
@@ -2247,8 +2243,6 @@ DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
       if (! NILP (Fequal (prop, XCAR (tail))))
 	return XCAR (XCDR (tail));
       tail = XCDR (tail);
-      if (EQ (tail, li.tortoise))
-	circular_list (plist);
     }
 
   CHECK_TYPE (NILP (tail), Qplistp, plist);
@@ -2280,8 +2274,6 @@ DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
 
       prev = tail;
       tail = XCDR (tail);
-      if (EQ (tail, li.tortoise))
-	circular_list (plist);
     }
   CHECK_TYPE (NILP (tail), Qplistp, plist);
   Lisp_Object newcell = list2 (prop, val);
@@ -3045,8 +3037,6 @@ DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
       tail = XCDR (tail);
       if (! CONSP (tail))
 	break;
-      if (EQ (tail, li.tortoise))
-	circular_list (tail);
     }
   CHECK_TYPE (NILP (tail), Qplistp, plist);
   return Qnil;
diff --git a/src/json.c b/src/json.c
index 23234c767d..48820a1cb0 100644
--- a/src/json.c
+++ b/src/json.c
@@ -404,7 +404,6 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp,
               tail = XCDR (tail);
               CHECK_CONS (tail);
               value = XCAR (tail);
-              if (EQ (tail, li.tortoise)) circular_list (lisp);
             }
           else
             {
-- 
2.20.1


[-- Attachment #3: 0001-Make-equal-symmetric.patch --]
[-- Type: text/x-patch, Size: 1587 bytes --]

From 57c8e010cea8dfb8d0e6d54992a7543c640c4f9f Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Thu, 27 Jun 2019 21:04:18 +0000
Subject: [PATCH] Make `equal' symmetric.

* src/fns.c (internal_equal): Make symmetric. Copy tortoise-hare
  algorithm from lisp.h
---
 src/fns.c | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index 2fc000a7f4..623435445a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2401,16 +2401,27 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
 	      return true;
 	  }
       else
-	FOR_EACH_TAIL (o1)
+	for (struct for_each_tail_internal li1 = { o1, 2, 0, 2 },
+	       li2 = { o2, 2, 0, 2 };
+	     CONSP (o1) && CONSP (o2);
+	     (o1 = XCDR (o1),
+	      o2 = XCDR (o2),
+	      ((--li1.q != 0
+		|| (maybe_quit (), 0 < --li1.n)
+		|| (li1.q = li1.n = li1.max <<= 1, li1.n >>= USHRT_WIDTH,
+		    li1.tortoise = (o1), false))
+	       && EQ (o1, li1.tortoise)) ? circular_list (o1) : (void) 0,
+	      ((--li2.q != 0
+		|| (maybe_quit (), 0 < --li2.n)
+		|| (li2.q = li2.n = li2.max <<= 1, li2.n >>= USHRT_WIDTH,
+		    li2.tortoise = (o2), false))
+	       && EQ (o2, li2.tortoise)) ? circular_list (o2) : (void) 0))
 	  {
-	    if (! CONSP (o2))
-	      return false;
+	    if (EQ (o1, o2))
+	      return true;
 	    if (! internal_equal (XCAR (o1), XCAR (o2),
 				  equal_kind, depth + 1, ht))
 	      return false;
-	    o2 = XCDR (o2);
-	    if (EQ (XCDR (o1), o2))
-	      return true;
 	  }
       depth++;
       goto tail_recurse;
-- 
2.20.1

bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

[Paul Eggert]

[-- Attachment #1: Type: text/plain, Size: 878 bytes --]

> I don't understand why the last two lines are there.

I thought those lines were needed to avoid an infinite loop in 
pathological cyclic cases. But on further thought you're right, they 
aren't needed. I installed that patch; thanks.

> shouldn't `equal' be symmetric?

Yes, on its domain. But circular lists are outside its domain, and the 
documentation doesn't promise any particular behavior on them. It's OK 
if (equal a b) signals an error and (equal b a) does not. It's even OK 
if (equal a b) signals an error and a later call (equal a b) with 
exactly the same (unchanged) arguments does not (because the stack 
happens to have more room the second time). We still have symmetry in 
the sense that (eq (equal a b) (equal b a)) always either returns t or 
signals an error; it never returns nil.

I installed the attached doc patch to try to make this a bit clearer.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Improve-equal-and-array-doc.patch --]
[-- Type: text/x-patch; name="0001-Improve-equal-and-array-doc.patch", Size: 3389 bytes --]

From bdbb390ffef9f8b4eab263055723b27edad7b91c Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 27 Jun 2019 15:39:04 -0700
Subject: [PATCH] =?UTF-8?q?Improve=20=E2=80=98equal=E2=80=99=20and=20array?=
 =?UTF-8?q?=20doc?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* doc/lispref/objects.texi (Array Type): Array sizes are
nonnegative fixnums, not arbitrary integers.
(Equality Predicates): Do not say that ‘eq’ equals ‘=’ on bignums.
Do not imply that ‘equal’ must signal an error on circular lists.
---
 doc/lispref/objects.texi | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 745baacc29..2e8e2ee714 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -964,7 +964,8 @@ Array Type
 
   A string is an array of characters and a vector is an array of
 arbitrary objects.  A bool-vector can hold only @code{t} or @code{nil}.
-These kinds of array may have any length up to the largest integer.
+These kinds of array may have any length up to the largest fixnum,
+subject to system architecture limits and available memory.
 Char-tables are sparse arrays indexed by any valid character code; they
 can hold arbitrary objects.
 
@@ -2085,7 +2086,7 @@ Equality Predicates
 This function returns @code{t} if @var{object1} and @var{object2} are
 the same object, and @code{nil} otherwise.
 
-If @var{object1} and @var{object2} are integers with the same value,
+If @var{object1} and @var{object2} are fixnums with the same value,
 they are considered to be the same object (i.e., @code{eq} returns
 @code{t}).  If @var{object1} and @var{object2} are symbols with the
 same name, they are normally the same object---but see @ref{Creating
@@ -2095,7 +2096,7 @@ Equality Predicates
 are the same object, meaning that a change in the contents of one will
 be reflected by the same change in the contents of the other.
 For other types of objects whose contents cannot be changed (e.g.,
-floats), two arguments with the same contents might or might not be
+bignums and floats), two arguments with the same contents might or might not be
 the same object, and @code{eq} returns @code{t} or @code{nil}
 depending on whether the Lisp interpreter created one object or two.
 
@@ -2258,7 +2259,7 @@ Equality Predicates
 their textual contents are the same.
 @end defun
 
-  The test for equality is implemented recursively; for example, given
+  For @code{equal}, equality is defined recursively; for example, given
 two cons cells @var{x} and @var{y}, @code{(equal @var{x} @var{y})}
 returns @code{t} if and only if both the expressions below return
 @code{t}:
@@ -2268,8 +2269,10 @@ Equality Predicates
 (equal (cdr @var{x}) (cdr @var{y}))
 @end example
 
-Because of this recursive method, circular lists may therefore cause
-infinite recursion (leading to an error).
+Comparing circular lists may therefore cause deep recursion that leads
+to an error, and this may result in counterintuitive behavior such as
+@code{(equal a b)} returning @code{t} whereas @code{(equal b a)}
+signals an error.
 
 @defun equal-including-properties object1 object2
 This function behaves like @code{equal} in all cases but also requires
-- 
2.21.0

bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

[Pip Cet]

On Thu, Jun 27, 2019 at 10:52 PM Paul Eggert <eggert@cs.ucla.edu> wrote:
> aren't needed. I installed that patch; thanks.

Thanks!

> > shouldn't `equal' be symmetric?
>
> Yes, on its domain. But circular lists are outside its domain, and the
> documentation doesn't promise any particular behavior on them. It's OK
> if (equal a b) signals an error and (equal b a) does not. It's even OK
> if (equal a b) signals an error and a later call (equal a b) with
> exactly the same (unchanged) arguments does not (because the stack
> happens to have more room the second time). We still have symmetry in
> the sense that (eq (equal a b) (equal b a)) always either returns t or
> signals an error; it never returns nil.

Thanks for your explanation, that makes perfect sense.

I was confused, in part, by the hash table code in internal_equal,
which appears to be designed to handle circular structures with some
generality.

On further thought, maybe that code is written for DAGs which contain
diamond-shaped subgraphs. However, those don't appear to be working
very well...

> I installed the attached doc patch to try to make this a bit clearer.

Thanks again! I'm closing this bug.

bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

[Glenn Morris]

This causes the test json-serialize/object to fail. Ref eg

https://hydra.nixos.org/build/95582609

bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

[Pip Cet]

[-- Attachment #1: Type: text/plain, Size: 353 bytes --]

On Sat, Jun 29, 2019 at 2:01 AM Glenn Morris <rgm@gnu.org> wrote:
> This causes the test json-serialize/object to fail. Ref eg
>
> https://hydra.nixos.org/build/95582609

So it does. It actually tests an odd-length circular "plist", which
fails both before and after the change, but fails with a different
error code. Modification to the test attached.

[-- Attachment #2: 0001-Fix-json-serialize-object-test-failure.patch --]
[-- Type: text/x-patch, Size: 1203 bytes --]

From a25a64203e3057b31fd2afc48bd762cc8a807d9d Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Sat, 29 Jun 2019 04:14:35 +0000
Subject: [PATCH] Fix json-serialize/object test failure.

* test/src/json-tests.el (json-serialize/object): Accept failure with
  different code.
---
 test/src/json-tests.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 7d824b5c95..383991b073 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -76,7 +76,8 @@ json-serialize/object
   (should (equal (json-serialize '(abc [1 2 t] :def :null))
                  "{\"abc\":[1,2,true],\"def\":null}"))
   (should-error (json-serialize '#1=(:a 1 . #1#)) :type 'circular-list)
-  (should-error (json-serialize '#1=(:a 1 :b . #1#)) :type 'circular-list)
+  (should-error (json-serialize '#1=(:a 1 :b . #1#)):type '(circular-list
+                                                            wrong-type-argument))
   (should-error (json-serialize '(:foo "bar" (unexpected-alist-key . 1)))
                 :type 'wrong-type-argument)
   (should-error (json-serialize '((abc . "abc") :unexpected-plist-key "key"))
-- 
2.20.1

bug#36407: 27.0.50; `plist-get', `equal' etc. and circular "lists"

[Paul Eggert]

Thanks, I installed that fix to the test case.