bug#25605: [DRAFT PATCH 1/2] Simplify use of FOR_EACH_TAIL

bug#25605: [DRAFT PATCH 1/2] Simplify use of FOR_EACH_TAIL

[Paul Eggert]

* src/data.c (circular_list): New function.
* src/lisp.h (FOR_EACH_TAIL): Use Brent’s algorithm and C99 for-loop
decl, to eliminate the need for the args TAIL, TORTOISE and N, and
to speed things up a bit on typical hosts with optimization.
All uses changed.
---
 src/data.c |  6 ++++++
 src/fns.c  | 16 +++++++---------
 src/lisp.h | 34 ++++++++++++++++++++--------------
 3 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/src/data.c b/src/data.c
index 8e07bf0..12dc2df 100644
--- a/src/data.c
+++ b/src/data.c
@@ -170,6 +170,12 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
   xsignal3 (Qargs_out_of_range, a1, a2, a3);
 }
 
+void
+circular_list (Lisp_Object list)
+{
+  xsignal1 (Qcircular_list, list);
+}
+
 \f
 /* Data type predicates.  */
 
diff --git a/src/fns.c b/src/fns.c
index ac7c1f2..4de74a5 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1544,25 +1544,23 @@ list.
 Write `(setq foo (delq element foo))' to be sure of correctly changing
 the value of a list `foo'.  See also `remq', which does not modify the
 argument.  */)
-  (register Lisp_Object elt, Lisp_Object list)
+  (Lisp_Object elt, Lisp_Object list)
 {
-  Lisp_Object tail, tortoise, prev = Qnil;
-  bool skip;
+  Lisp_Object prev = Qnil;
 
-  FOR_EACH_TAIL (tail, list, tortoise, skip)
+  FOR_EACH_TAIL (list)
     {
-      Lisp_Object tem = XCAR (tail);
+      Lisp_Object tem = XCAR (li.tail);
       if (EQ (elt, tem))
 	{
 	  if (NILP (prev))
-	    list = XCDR (tail);
+	    list = XCDR (li.tail);
 	  else
-	    Fsetcdr (prev, XCDR (tail));
+	    Fsetcdr (prev, XCDR (li.tail));
 	}
       else
-	prev = tail;
+	prev = li.tail;
     }
-  CHECK_LIST_END (tail, list);
   return list;
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 1ac3816..2d74d44 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3317,6 +3317,7 @@ extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
 extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
 					   Lisp_Object);
+extern _Noreturn void circular_list (Lisp_Object);
 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
 enum Set_Internal_Bind {
   SET_INTERNAL_SET,
@@ -4586,20 +4587,25 @@ enum
 	 Lisp_String))							\
      : make_unibyte_string (str, len))
 
-/* Loop over all tails of a list, checking for cycles.
-   FIXME: Make tortoise and n internal declarations.
-   FIXME: Unroll the loop body so we don't need `n'.  */
-#define FOR_EACH_TAIL(hare, list, tortoise, n)	\
-  for ((tortoise) = (hare) = (list), (n) = true;		\
-       CONSP (hare);						\
-       (hare = XCDR (hare), (n) = !(n),				\
-   	((n)							\
-   	 ? (EQ (hare, tortoise)					\
-	    ? xsignal1 (Qcircular_list, list)			\
-	    : (void) 0)						\
-	 /* Move tortoise before the next iteration, in case */ \
-	 /* the next iteration does an Fsetcdr.  */		\
-   	 : (void) ((tortoise) = XCDR (tortoise)))))
+/* Loop over tails of LIST, checking for dotted lists and cycles.
+   In the loop body, ‘li.tail’ is the current cons; the name ‘li’ is
+   short for “list iterator”.  The expression LIST may be evaluated
+   more than once, and so should not have side effects.  The loop body
+   should not modify the list’s top level structure other than by
+   perhaps deleting the current cons.
+
+   Use Brent’s teleporting tortoise-hare algorithm.  See:
+   Brent RP. BIT. 1980;20(2):176-84. doi:10.1007/BF01933190
+   http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf  */
+
+#define FOR_EACH_TAIL(list)						\
+  for (struct { Lisp_Object tail, tortoise; intptr_t n, max; } li	\
+	 = { list, list, 2, 2 };					\
+       CONSP (li.tail) || (CHECK_LIST_END (li.tail, list), false);	\
+       (li.tail = XCDR (li.tail),					\
+	(li.n-- == 0							\
+	 ? (void) (li.n = li.max <<= 1, li.tortoise = li.tail)		\
+	 : EQ (li.tail, li.tortoise) ? circular_list (list) : (void) 0)))
 
 /* Do a `for' loop over alist values.  */
 
-- 
2.9.3

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Paul Eggert]

Use macros like FOR_EACH_TAIL instead of maybe_quit to
catch list cycles automatically instead of relying on the
user becoming impatient and typing C-g.
* src/fns.c (Flength, Fmember, Fmemq, Fmemql, Fassq, Fassoc, Frassq)
(Frassoc, Fdelete, Freverse):
Use FOR_EACH_TAIL instead of maybe_quit.
(Fnreverse): Use simple EQ to check for circular list instead
of rarely_quit, as this suffices in this unusual case.
(Fplist_put, Flax_plist_put, Flax_plist_put):
Use FOR_EACH_TAIL_CONS instead of maybe_quit.
(internal_equal): Use FOR_EACH_TAIL_CONS to check lists, instead
of by-hand tail recursion that did not catch cycles.
* src/fns.c (Fsafe_length, Fplist_get):
* src/xdisp.c (display_mode_element):
Use FOR_EACH_TAIL_SAFE instead of by-hand Floyd’s algorithm.
* src/lisp.h (QUIT_COUNT_HEURISTIC): Remove; no longer needed.
(rarely_quit): Simply count toward USHRT_MAX + 1, since the
fancier versions are no longer needed.
(FOR_EACH_TAIL_CONS, FOR_EACH_TAIL_SAFE)
(FOR_EACH_TAIL_INTERNAL): New macros, the last with definiens
mostly taken from FOR_EACH_TAIL.
(FOR_EACH_TAIL): Rewrite in terms of FOR_EACH_TAIL_INTERNAL.
---
 etc/NEWS    |   3 +
 src/fns.c   | 290 +++++++++++++++++++++++-------------------------------------
 src/lisp.h  |  35 +++++---
 src/xdisp.c |  37 +++-----
 4 files changed, 149 insertions(+), 216 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 86a8385..23e5111 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -872,6 +872,9 @@ collection).
 +++
 ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp.
 
+** Low-level list functions like 'length' and 'member' now do a better
+job of signaling list cycles instead of looping indefinitely.
+
 +++
 ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
 can be used for creation of temporary files of remote or mounted directories.
diff --git a/src/fns.c b/src/fns.c
index 4de74a5..b5508fb 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -108,23 +108,11 @@ To get the number of bytes, use `string-bytes'.  */)
     XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
   else if (CONSP (sequence))
     {
-      EMACS_INT i = 0;
-
-      do
-	{
-	  ++i;
-	  if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
-	    {
-	      if (MOST_POSITIVE_FIXNUM < i)
-		error ("List too long");
-	      maybe_quit ();
-	    }
-	  sequence = XCDR (sequence);
-	}
-      while (CONSP (sequence));
-
-      CHECK_LIST_END (sequence, sequence);
-
+      intptr_t i = 0;
+      FOR_EACH_TAIL (sequence)
+	i++;
+      if (MOST_POSITIVE_FIXNUM < i)
+	error ("List too long");
       val = make_number (i);
     }
   else if (NILP (sequence))
@@ -142,38 +130,10 @@ it returns 0.  If LIST is circular, it returns a finite value
 which is at least the number of distinct elements.  */)
   (Lisp_Object list)
 {
-  Lisp_Object tail, halftail;
-  double hilen = 0;
-  uintmax_t lolen = 1;
-
-  if (! CONSP (list))
-    return make_number (0);
-
-  /* halftail is used to detect circular lists.  */
-  for (tail = halftail = list; ; )
-    {
-      tail = XCDR (tail);
-      if (! CONSP (tail))
-	break;
-      if (EQ (tail, halftail))
-	break;
-      lolen++;
-      if ((lolen & 1) == 0)
-	{
-	  halftail = XCDR (halftail);
-	  if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
-	    {
-	      maybe_quit ();
-	      if (lolen == 0)
-		hilen += UINTMAX_MAX + 1.0;
-	    }
-	}
-    }
-
-  /* If the length does not fit into a fixnum, return a float.
-     On all known practical machines this returns an upper bound on
-     the true length.  */
-  return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
+  intptr_t len = 0;
+  FOR_EACH_TAIL_SAFE (list)
+    len++;
+  return make_fixnum_or_float (len);
 }
 
 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@@ -1383,15 +1343,9 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0,
 The value is actually the tail of LIST whose car is ELT.  */)
   (Lisp_Object elt, Lisp_Object list)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
-    {
-      if (! NILP (Fequal (elt, XCAR (tail))))
-	return tail;
-      rarely_quit (++quit_count);
-    }
-  CHECK_LIST_END (tail, list);
+  FOR_EACH_TAIL (list)
+    if (! NILP (Fequal (elt, XCAR (li.tail))))
+      return li.tail;
   return Qnil;
 }
 
@@ -1400,15 +1354,9 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
 The value is actually the tail of LIST whose car is ELT.  */)
   (Lisp_Object elt, Lisp_Object list)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
-    {
-      if (EQ (XCAR (tail), elt))
-	return tail;
-      rarely_quit (++quit_count);
-    }
-  CHECK_LIST_END (tail, list);
+  FOR_EACH_TAIL (list)
+    if (EQ (XCAR (li.tail), elt))
+      return li.tail;
   return Qnil;
 }
 
@@ -1420,16 +1368,12 @@ The value is actually the tail of LIST whose car is ELT.  */)
   if (!FLOATP (elt))
     return Fmemq (elt, list);
 
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  FOR_EACH_TAIL (list)
     {
-      Lisp_Object tem = XCAR (tail);
+      Lisp_Object tem = XCAR (li.tail);
       if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
-	return tail;
-      rarely_quit (++quit_count);
+	return li.tail;
     }
-  CHECK_LIST_END (tail, list);
   return Qnil;
 }
 
@@ -1439,15 +1383,9 @@ The value is actually the first element of LIST whose car is KEY.
 Elements of LIST that are not conses are ignored.  */)
   (Lisp_Object key, Lisp_Object list)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
-    {
-      if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
-	return XCAR (tail);
-      rarely_quit (++quit_count);
-    }
-  CHECK_LIST_END (tail, list);
+  FOR_EACH_TAIL (list)
+    if (CONSP (XCAR (li.tail)) && EQ (XCAR (XCAR (li.tail)), key))
+      return XCAR (li.tail);
   return Qnil;
 }
 
@@ -1468,17 +1406,13 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
 The value is actually the first element of LIST whose car equals KEY.  */)
   (Lisp_Object key, Lisp_Object list)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  FOR_EACH_TAIL (list)
     {
-      Lisp_Object car = XCAR (tail);
+      Lisp_Object car = XCAR (li.tail);
       if (CONSP (car)
 	  && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
 	return car;
-      rarely_quit (++quit_count);
     }
-  CHECK_LIST_END (tail, list);
   return Qnil;
 }
 
@@ -1503,15 +1437,9 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
 The value is actually the first element of LIST whose cdr is KEY.  */)
   (Lisp_Object key, Lisp_Object list)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
-    {
-      if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
-	return XCAR (tail);
-      rarely_quit (++quit_count);
-    }
-  CHECK_LIST_END (tail, list);
+  FOR_EACH_TAIL (list)
+    if (CONSP (XCAR (li.tail)) && EQ (XCDR (XCAR (li.tail)), key))
+      return XCAR (li.tail);
   return Qnil;
 }
 
@@ -1520,17 +1448,13 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
 The value is actually the first element of LIST whose cdr equals KEY.  */)
   (Lisp_Object key, Lisp_Object list)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  FOR_EACH_TAIL (list)
     {
-      Lisp_Object car = XCAR (tail);
+      Lisp_Object car = XCAR (li.tail);
       if (CONSP (car)
 	  && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
 	return car;
-      rarely_quit (++quit_count);
     }
-  CHECK_LIST_END (tail, list);
   return Qnil;
 }
 \f
@@ -1668,23 +1592,20 @@ changing the value of a sequence `foo'.  */)
     }
   else
     {
-      unsigned short int quit_count = 0;
-      Lisp_Object tail, prev;
+      Lisp_Object prev = Qnil;
 
-      for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
+      FOR_EACH_TAIL (seq)
 	{
-	  if (!NILP (Fequal (elt, XCAR (tail))))
+	  if (!NILP (Fequal (elt, (XCAR (li.tail)))))
 	    {
 	      if (NILP (prev))
-		seq = XCDR (tail);
+		seq = XCDR (li.tail);
 	      else
-		Fsetcdr (prev, XCDR (tail));
+		Fsetcdr (prev, XCDR (li.tail));
 	    }
 	  else
-	    prev = tail;
-	  rarely_quit (++quit_count);
+	    prev = li.tail;
 	}
-      CHECK_LIST_END (tail, seq);
     }
 
   return seq;
@@ -1702,15 +1623,17 @@ This function may destructively modify SEQ to produce the value.  */)
     return Freverse (seq);
   else if (CONSP (seq))
     {
-      unsigned short int quit_count = 0;
       Lisp_Object prev, tail, next;
 
       for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
 	{
 	  next = XCDR (tail);
+	  /* If SEQ contains a cycle, attempting to reverse it
+	     in-place will inevitably come back to SEQ.  */
+	  if (EQ (next, seq))
+	    circular_list (seq);
 	  Fsetcdr (tail, prev);
 	  prev = tail;
-	  rarely_quit (++quit_count);
 	}
       CHECK_LIST_END (tail, seq);
       seq = prev;
@@ -1753,13 +1676,9 @@ See also the function `nreverse', which is used more often.  */)
     return Qnil;
   else if (CONSP (seq))
     {
-      unsigned short int quit_count = 0;
-      for (new = Qnil; CONSP (seq); seq = XCDR (seq))
-	{
-	  new = Fcons (XCAR (seq), new);
-	  rarely_quit (++quit_count);
-	}
-      CHECK_LIST_END (seq, seq);
+      new = Qnil;
+      FOR_EACH_TAIL (seq)
+	new = Fcons (XCAR (li.tail), new);
     }
   else if (VECTORP (seq))
     {
@@ -2011,18 +1930,14 @@ corresponding to the given PROP, or nil if PROP is not one of the
 properties on the list.  This function never signals an error.  */)
   (Lisp_Object plist, Lisp_Object prop)
 {
-  Lisp_Object tail, halftail;
-
-  /* halftail is used to detect circular lists.  */
-  tail = halftail = plist;
-  while (CONSP (tail) && CONSP (XCDR (tail)))
+  FOR_EACH_TAIL_SAFE (plist)
     {
-      if (EQ (prop, XCAR (tail)))
-	return XCAR (XCDR (tail));
-
-      tail = XCDR (XCDR (tail));
-      halftail = XCDR (halftail);
-      if (EQ (tail, halftail))
+      if (! CONSP (XCDR (li.tail)))
+	break;
+      if (EQ (prop, XCAR (li.tail)))
+	return XCAR (XCDR (li.tail));
+      li.tail = XCDR (li.tail);
+      if (EQ (li.tail, li.tortoise))
 	break;
     }
 
@@ -2048,19 +1963,22 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
 The PLIST is modified by side effects.  */)
   (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
 {
-  unsigned short int quit_count = 0;
   Lisp_Object prev = Qnil;
-  for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
-       tail = XCDR (XCDR (tail)))
+  FOR_EACH_TAIL_CONS (plist)
     {
-      if (EQ (prop, XCAR (tail)))
+      if (! CONSP (XCDR (li.tail)))
+	break;
+
+      if (EQ (prop, XCAR (li.tail)))
 	{
-	  Fsetcar (XCDR (tail), val);
+	  Fsetcar (XCDR (li.tail), val);
 	  return plist;
 	}
 
-      prev = tail;
-      rarely_quit (++quit_count);
+      prev = li.tail;
+      li.tail = XCDR (li.tail);
+      if (EQ (li.tail, li.tortoise))
+	circular_list (plist);
     }
   Lisp_Object newcell
     = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
@@ -2089,20 +2007,16 @@ corresponding to the given PROP, or nil if PROP is not
 one of the properties on the list.  */)
   (Lisp_Object plist, Lisp_Object prop)
 {
-  unsigned short int quit_count = 0;
-  Lisp_Object tail;
-
-  for (tail = plist;
-       CONSP (tail) && CONSP (XCDR (tail));
-       tail = XCDR (XCDR (tail)))
+  FOR_EACH_TAIL_CONS (plist)
     {
-      if (! NILP (Fequal (prop, XCAR (tail))))
-	return XCAR (XCDR (tail));
-      rarely_quit (++quit_count);
+      if (! CONSP (XCDR (li.tail)))
+	break;
+      if (! NILP (Fequal (prop, XCAR (li.tail))))
+	return XCAR (XCDR (li.tail));
+      li.tail = XCDR (li.tail);
+      if (EQ (li.tail, li.tortoise))
+	circular_list (plist);
     }
-
-  CHECK_LIST_END (tail, prop);
-
   return Qnil;
 }
 
@@ -2116,19 +2030,22 @@ use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
 The PLIST is modified by side effects.  */)
   (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
 {
-  unsigned short int quit_count = 0;
   Lisp_Object prev = Qnil;
-  for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
-       tail = XCDR (XCDR (tail)))
+  FOR_EACH_TAIL_CONS (plist)
     {
-      if (! NILP (Fequal (prop, XCAR (tail))))
+      if (! CONSP (XCDR (li.tail)))
+	break;
+
+      if (! NILP (Fequal (prop, XCAR (li.tail))))
 	{
-	  Fsetcar (XCDR (tail), val);
+	  Fsetcar (XCDR (li.tail), val);
 	  return plist;
 	}
 
-      prev = tail;
-      rarely_quit (++quit_count);
+      prev = li.tail;
+      li.tail = XCDR (li.tail);
+      if (EQ (li.tail, li.tortoise))
+	circular_list (plist);
     }
   Lisp_Object newcell = list2 (prop, val);
   if (NILP (prev))
@@ -2206,9 +2123,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
 	}
     }
 
-  unsigned short int quit_count = 0;
  tail_recurse:
-  rarely_quit (++quit_count);
   if (EQ (o1, o2))
     return 1;
   if (XTYPE (o1) != XTYPE (o2))
@@ -2228,12 +2143,24 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
       }
 
     case Lisp_Cons:
-      if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
-	return 0;
-      o1 = XCDR (o1);
-      o2 = XCDR (o2);
-      /* FIXME: This inf-loops in a circular list!  */
-      goto tail_recurse;
+      {
+	Lisp_Object tail1 = o1;
+	FOR_EACH_TAIL_CONS (o1)
+	  {
+	    if (! CONSP (o2))
+	      return false;
+	    if (! internal_equal (XCAR (li.tail), XCAR (o2), depth + 1,
+				  props, ht))
+	      return false;
+	    tail1 = XCDR (li.tail);
+	    o2 = XCDR (o2);
+	    if (EQ (tail1, o2))
+	      return true;
+	  }
+	o1 = tail1;
+	depth++;
+	goto tail_recurse;
+      }
 
     case Lisp_Misc:
       if (XMISCTYPE (o1) != XMISCTYPE (o2))
@@ -2247,6 +2174,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
 	    return 0;
 	  o1 = XOVERLAY (o1)->plist;
 	  o2 = XOVERLAY (o2)->plist;
+	  depth++;
 	  goto tail_recurse;
 	}
       if (MARKERP (o1))
@@ -2397,7 +2325,6 @@ Only the last argument is not altered, and need not be a list.
 usage: (nconc &rest LISTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  unsigned short int quit_count = 0;
   Lisp_Object val = Qnil;
 
   for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
@@ -2413,13 +2340,8 @@ usage: (nconc &rest LISTS)  */)
       CHECK_CONS (tem);
 
       Lisp_Object tail;
-      do
-	{
-	  tail = tem;
-	  tem = XCDR (tail);
-	  rarely_quit (++quit_count);
-	}
-      while (CONSP (tem));
+      FOR_EACH_TAIL_CONS (tem)
+	tail = li.tail;
 
       tem = args[argnum + 1];
       Fsetcdr (tail, tem);
@@ -2841,14 +2763,20 @@ property and a property with the value nil.
 The value is actually the tail of PLIST whose car is PROP.  */)
   (Lisp_Object plist, Lisp_Object prop)
 {
-  unsigned short int quit_count = 0;
-  while (CONSP (plist) && !EQ (XCAR (plist), prop))
+  FOR_EACH_TAIL (plist)
     {
-      plist = XCDR (plist);
-      plist = CDR (plist);
-      rarely_quit (++quit_count);
+      if (EQ (XCAR (li.tail), prop))
+	return li.tail;
+      if (!CONSP (XCDR (li.tail)))
+	{
+	  CHECK_LIST_END (XCDR (li.tail), plist);
+	  return Qnil;
+	}
+      li.tail = XCDR (li.tail);
+      if (EQ (li.tail, li.tortoise))
+	circular_list (plist);
     }
-  return plist;
+  return Qnil;
 }
 
 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
diff --git a/src/lisp.h b/src/lisp.h
index 2d74d44..275e0fc 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3129,20 +3129,14 @@ extern void maybe_quit (void);
 
 #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 
-/* Heuristic on how many iterations of a tight loop can be safely done
-   before it's time to do a quit.  This must be a power of 2.  It
-   is nice but not necessary for it to equal USHRT_MAX + 1.  */
-
-enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-
 /* Process a quit rarely, based on a counter COUNT, for efficiency.
-   "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
-   times, whichever is smaller (somewhat arbitrary, but often faster).  */
+   "Rarely" means once per USHRT_MAX + 1 times; this is somewhat
+   arbitrary, but efficient.  */
 
 INLINE void
 rarely_quit (unsigned short int count)
 {
-  if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
+  if (! count)
     maybe_quit ();
 }
 \f
@@ -4599,13 +4593,32 @@ enum
    http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf  */
 
 #define FOR_EACH_TAIL(list)						\
+  FOR_EACH_TAIL_INTERNAL (list, CHECK_LIST_END (li.tail, list),		\
+			  circular_list (list))
+
+/* Like FOR_EACH_TAIL (LIST), except check only for cycles.  */
+
+#define FOR_EACH_TAIL_CONS(list) \
+  FOR_EACH_TAIL_INTERNAL (list, (void) 0, circular_list (list))
+
+/* Like FOR_EACH_TAIL (LIST), except check for neither dotted lists
+   nor cycles.  */
+
+#define FOR_EACH_TAIL_SAFE(list) \
+  FOR_EACH_TAIL_INTERNAL (list, (void) 0, (void) (li.tail = Qnil))
+
+/* Like FOR_EACH_TAIL (LIST), except evaluate DOTTED or CYCLE,
+   respectively, if a dotted list or cycle is found.  This is an
+   internal macro intended for use only by the above macros.  */
+
+#define FOR_EACH_TAIL_INTERNAL(list, dotted, cycle)			\
   for (struct { Lisp_Object tail, tortoise; intptr_t n, max; } li	\
 	 = { list, list, 2, 2 };					\
-       CONSP (li.tail) || (CHECK_LIST_END (li.tail, list), false);	\
+       CONSP (li.tail) || (dotted, false);				\
        (li.tail = XCDR (li.tail),					\
 	(li.n-- == 0							\
 	 ? (void) (li.n = li.max <<= 1, li.tortoise = li.tail)		\
-	 : EQ (li.tail, li.tortoise) ? circular_list (list) : (void) 0)))
+	 : EQ (li.tail, li.tortoise) ? (cycle) : (void) 0)))
 
 /* Do a `for' loop over alist values.  */
 
diff --git a/src/xdisp.c b/src/xdisp.c
index 33661c8..31c1fe1 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -23055,30 +23055,19 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
 	    goto tail_recurse;
 	  }
 	else if (STRINGP (car) || CONSP (car))
-	  {
-	    Lisp_Object halftail = elt;
-	    int len = 0;
-
-	    while (CONSP (elt)
-		   && (precision <= 0 || n < precision))
-	      {
-		n += display_mode_element (it, depth,
-					   /* Do padding only after the last
-					      element in the list.  */
-					   (! CONSP (XCDR (elt))
-					    ? field_width - n
-					    : 0),
-					   precision - n, XCAR (elt),
-					   props, risky);
-		elt = XCDR (elt);
-		len++;
-		if ((len & 1) == 0)
-		  halftail = XCDR (halftail);
-		/* Check for cycle.  */
-		if (EQ (halftail, elt))
-		  break;
-	      }
-	  }
+	  FOR_EACH_TAIL_SAFE (elt)
+	    {
+	      if (0 < precision && precision <= n)
+		break;
+	      n += display_mode_element (it, depth,
+					 /* Pad after only the last
+					    list element.  */
+					 (! CONSP (XCDR (li.tail))
+					  ? field_width - n
+					  : 0),
+					 precision - n, XCAR (li.tail),
+					 props, risky);
+	    }
       }
       break;
 
-- 
2.9.3

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Eli Zaretskii]

> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Wed,  1 Feb 2017 15:56:22 -0800
> Cc: Paul Eggert <eggert@cs.ucla.edu>
> 
> Use macros like FOR_EACH_TAIL instead of maybe_quit to
> catch list cycles automatically instead of relying on the
> user becoming impatient and typing C-g.

I don't think this is a good idea.  We don't know when the user will
become impatient, and on busy systems the counter could be very low by
that time.  I think we shouldn't second-guess users this way, and
should always leave them the possibility of interrupting a possibly
prolonged calculation.

Also, could we please have tests for these functions?

Thanks.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Paul Eggert]

On 02/02/2017 09:28 AM, Eli Zaretskii wrote:

> could we please have tests for these functions?
Good point, I'll look into adding some.

> I think we shouldn't second-guess users this way, and
> should always leave them the possibility of interrupting a possibly
> prolonged calculation.

Sure, but we shouldn't insert maybe_quit calls after every nanosecond's 
worth of computation; that'd be overkill and would slow down Emacs 
unnecessarily. We should insert a maybe_quit call only when Emacs may 
have done enough computation that it would be annoying if the user typed 
C-g and Emacs did not respond for that period of time.

A reasonable rule of thumb is that if an operation can take longer than 
a garbage collection, then we should insert a maybe_quit in its loop 
body. Conversely, if an operation is always significantly faster then 
GC, then we needn't bother inserting maybe_quit, as Emacs cannot quit in 
the middle of GC anyway (and if we ever get around to fixing *that* 
problem then we will likely be able use the fix approach to attack the 
problem everywhere, not just in GC).

This rule of thumb corresponds pretty closely to what Emacs is already 
doing. For example, Emacs does a maybe_quit while doing regex searching, 
as in practice buffers can be quite large and searching them can easily 
take longer than a GC. In contrast, Emacs does not do a maybe_quit when 
FACE_FOR_CHAR searches font-encoding-charset-alist, as in practice that 
list is never so long that the a user would notice any C-g delay (and if 
the list actually did contain billions of elements (!), GC would be slow 
too as it would have to mark the list).

With cycle checking, all the loops containing removed maybe_quits are 
waaaay faster than a GC would be, which is why these loops don't need 
those maybe_quit calls once they start checking for list cycles.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Thu, 2 Feb 2017 15:01:16 -0800
> 
> On 02/02/2017 09:28 AM, Eli Zaretskii wrote:
> 
> > could we please have tests for these functions?
> Good point, I'll look into adding some.

Thanks.

> > I think we shouldn't second-guess users this way, and
> > should always leave them the possibility of interrupting a possibly
> > prolonged calculation.
> 
> Sure, but we shouldn't insert maybe_quit calls after every nanosecond's 
> worth of computation; that'd be overkill and would slow down Emacs 
> unnecessarily.

No, not that frequently, I agree.  So perhaps rarely_quit is a better
possibility in these places.

But in general, data structures on which these primitives work could
be rather large, and processing them could take a tangible amount of
time.  Moreover, on a memory-starved system or a system under heavy
computational load, the processing could take a long elapsed time even
if the CPU time used by Emacs is very small.  Users get annoyed by
elapsed time, because that's what they perceive.  So making these
uninterruptible except in case of glaring bugs sounds like losing a
valuable fire escape to me.

> We should insert a maybe_quit call only when Emacs may have done
> enough computation that it would be annoying if the user typed C-g
> and Emacs did not respond for that period of time.

Sure.  But do we have a reliable device to measure this quantity?
Once again, the elapsed time tends to annoy users regardless of the
real computational resources used by Emacs.

IOW, the removal is probably justified for 90% of use cases, maybe
even more, but it could be a problem for a small fraction of use
cases.  And since quitting is a kind of zero-level troubleshooting in
Emacs, I think we should be biased towards those rare cases here.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Paul Eggert]

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

On 02/02/2017 11:55 PM, Eli Zaretskii wrote:

> the removal is probably justified for 90% of use cases, maybe
> even more

It's 100%, as in practice any use case that has trouble because of the 
code removal will have significantly worse trouble on every GC (which is 
also noninterruptible). memq calls maybe_quit because of circular lists, 
not because of lists of length 1 billion, as huge lists don't work well 
with Emacs anyway (due to GC).

I wrote a little benchmark to try this out (attached), which used the 
new memq. On my workstation at UCLA the results were either:

1. The benchmark was so large that Emacs froze my system while building 
the test-case list, i.e., before any of the newly-affected code was 
executed. This was due to page thrashing. Obviously the draft change is 
irrelevant here.

2. The benchmark was so small that it finished instantly, from the 
user's viewpoint. Obviously not a problem.

3. The benchmark was medium sized (in my case, this was a list with 100 
million entries), so that Emacs was painfully slow but still barely 
usable while the test case was being built or while garbage collection 
was being done. In this case, the new memq was the least of the user's 
problems, as the new memq was 4x faster than a garbage collect so the 
C-g was delayed annoyingly for GC anyway. That is, GC makes Emacs so 
painful to use even with length-100-million lists that people won't use 
Emacs that way and we don't need to worry about treating such lists 
specially.

Of course I can't test all possible use cases. But if there's a 
practical use case where the draft patch will cause a problem, I haven't 
seen it yet.

By the way, I have found many cases where Emacs master will loop forever 
and will ignore C-g. If you like, I can privately send you an Elisp 
expression that, if you evaluate it, you cannot C-g out of. This problem 
is independent of the draft patch, and is far more serious than the 
somewhat-theoretical discussion we're having about memq and friends.


[-- Attachment #2: bigmemq.el --]
[-- Type: text/plain, Size: 644 bytes --]

(defun bigmemq (n)
  (let ((t0 (float-time (current-time))))
    (message "Running make-list...")
    (let ((long (make-list n nil))
          (t1 (float-time (current-time))))
      (message "Running make-list... done in %s seconds" (- t1 t0))
      (message "Running memq...")
      (let ((result (memq t long))
            (t2 (float-time (current-time))))
        (message "Running memq... done in %s seconds" (- t2 t1))
        (message "Running garbage-collect...")
        (garbage-collect)
        (let ((t3 (float-time (current-time))))
          (message "Running garbage-collect... done in %s seconds" (- t3 t2)))
        result))))

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Fri, 3 Feb 2017 12:29:11 -0800
> 
> On 02/02/2017 11:55 PM, Eli Zaretskii wrote:
> 
> > the removal is probably justified for 90% of use cases, maybe
> > even more
> 
> It's 100%

There is no 100% in real life, so if you want to convince me, you will
never use such arguments.

> as in practice any use case that has trouble because of the 
> code removal will have significantly worse trouble on every GC (which is 
> also noninterruptible). memq calls maybe_quit because of circular lists, 
> not because of lists of length 1 billion, as huge lists don't work well 
> with Emacs anyway (due to GC).

I don't see how arguments related to GC are relevant to the issue at
hand.  I'm interested in only one aspect of this change: how it is a
good idea to lose the ability to interrupt long loops processing large
Lisp data structures.

> 1. The benchmark was so large that Emacs froze my system while building 
> the test-case list, i.e., before any of the newly-affected code was 
> executed. This was due to page thrashing. Obviously the draft change is 
> irrelevant here.

I disagree that a use case with a paging system is irrelevant.

> 3. The benchmark was medium sized (in my case, this was a list with 100 
> million entries), so that Emacs was painfully slow but still barely 
> usable while the test case was being built or while garbage collection 
> was being done. In this case, the new memq was the least of the user's 
> problems, as the new memq was 4x faster than a garbage collect so the 
> C-g was delayed annoyingly for GC anyway. That is, GC makes Emacs so 
> painful to use even with length-100-million lists that people won't use 
> Emacs that way and we don't need to worry about treating such lists 
> specially.

Once again, the issue with GC is not relevant.  And the fact that
removing some code makes loops faster is trivial and also not
relevant.

I'm sorry, but I remain unconvinced that we should remove these
calls.  I'm okay with replacing maybe_quit with rarely_quit, which
should strike some hopefully more optimal middle ground.

> By the way, I have found many cases where Emacs master will loop forever 
> and will ignore C-g. If you like, I can privately send you an Elisp 
> expression that, if you evaluate it, you cannot C-g out of. This problem 
> is independent of the draft patch, and is far more serious than the 
> somewhat-theoretical discussion we're having about memq and friends.

We need to solve those problems, but that doesn't mean we should
introduce new ones elsewhere.  Being able to interrupt long loops in
Emacs is an important feature.

Thanks.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Paul Eggert]

Eli Zaretskii wrote:
> I remain unconvinced that we should remove these calls.

I've provided several use cases and test code, all of which suggest that the 
maybe_quit calls are unnecessary. You have given no use cases that suggest 
otherwise. So I'm puzzled as to why you remain convinced that these calls are 
needed. All I'm asking for is a practical use case; it shouldn't be that hard to 
give one, if the calls are really important.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sat, 4 Feb 2017 11:11:48 -0800
> 
> Eli Zaretskii wrote:
> > I remain unconvinced that we should remove these calls.
> 
> I've provided several use cases and test code, all of which suggest that the 
> maybe_quit calls are unnecessary. You have given no use cases that suggest 
> otherwise. So I'm puzzled as to why you remain convinced that these calls are 
> needed. All I'm asking for is a practical use case; it shouldn't be that hard to 
> give one, if the calls are really important.

I did provide use cases, you just dismiss them as unimportant.  They
are rare and perhaps even marginal, but they do exist.  And this
feature exists precisely for rare and marginal situations.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Paul Eggert]

Eli Zaretskii wrote:

> I did provide use cases, you just dismiss them as unimportant.

You mentioned use cases consisting of "a memory-starved system or a system under 
heavy computational load". My test code attempted to exercise both 
possibilities, under different scenarios. My tests came up empty: there were no 
cases that caused new problems. Perhaps I misunderstood what you were driving 
at, but if so I would like to know what it was. Possibly there is a 
more-efficient change that would satisfy your concerns, once I understand them.

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sat, 4 Feb 2017 13:45:21 -0800
> 
> Eli Zaretskii wrote:
> 
> > I did provide use cases, you just dismiss them as unimportant.
> 
> You mentioned use cases consisting of "a memory-starved system or a system under 
> heavy computational load". My test code attempted to exercise both 
> possibilities, under different scenarios. My tests came up empty: there were no 
> cases that caused new problems.

That was your interpretation of the results.  It isn't mine: I don't
think that the fact that in your particular testing GC was a bugger
problem than the uninterruptible loop means the ability to interrupt
those loops has no value.

Besides, one particular simulation of the problem is not convincing
enough anyway.

> Perhaps I misunderstood what you were driving at, but if so I would
> like to know what it was.

I don't see what else can I explain in addition to what I already did.

> Possibly there is a more-efficient change that would satisfy your
> concerns, once I understand them.

How about if I turn the table and ask why is it so important to remove
those calls?

bug#25606: [DRAFT PATCH 2/2] Signal list cycles in ‘length’ etc.

[Paul Eggert]

Eli Zaretskii wrote:

> How about if I turn the table and ask why is it so important to remove
> those calls?

Because they make Emacs bigger and slower for no good reason. A vague feeling 
that there might be a need for them in an unrealistic use case is not a good 
reason. However, your mind is made up and we're wasting time discussing this, so 
I give up and will install a patch with the unnecessary code.

bug#25605: [DRAFT PATCH 1/2] Simplify use of FOR_EACH_TAIL

[Eli Zaretskii]

> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Wed,  1 Feb 2017 15:56:21 -0800
> Cc: Paul Eggert <eggert@cs.ucla.edu>
> 
> * src/data.c (circular_list): New function.
> * src/lisp.h (FOR_EACH_TAIL): Use Brent’s algorithm and C99 for-loop
> decl, to eliminate the need for the args TAIL, TORTOISE and N, and
> to speed things up a bit on typical hosts with optimization.
> All uses changed.

Thanks, but I wonder if you could add some tests for the relevant
functions, I really feel uneasy about changing the implementation of
such basic functionality without any regression tests.

bug#25605: patches installed for 25605, 25606

[Paul Eggert]

I installed patches for Bug#25605 and Bug#25606, along with all suggested 
revisions to the patches, and am closing the bug reports.

bug#25605: bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sun, 5 Feb 2017 13:30:54 -0800
> 
> I installed patches for Bug#25605 and Bug#25606, along with all suggested 
> revisions to the patches, and am closing the bug reports.

Thanks.

Any reasons why the tests are in manual/cyclic-tests.el, and not in
src/fns-tests.el?  The tests don't need to be run interactively, do
they?

bug#25605: bug#25606: patches installed for 25605, 25606

[Paul Eggert]

Eli Zaretskii wrote:
> Any reasons why the tests are in manual/cyclic-tests.el, and not in
> src/fns-tests.el?

No particular reason, no. I don't know my way around the test directories well; 
please feel free to move them.

> The tests don't need to be run interactively, do
> they?

Only if they fail (i.e., loop forever).

bug#25606: patches installed for 25605, 25606

[Philipp Stephani]

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

Paul Eggert <eggert@cs.ucla.edu> schrieb am Di., 7. Feb. 2017 um 07:54 Uhr:

>
> > The tests don't need to be run interactively, do
> > they?
>
> Only if they fail (i.e., loop forever).
>
>
If they fail, shouldn't the test runner that runs these tests time out
after some time and mark them as failures?

[-- Attachment #2: Type: text/html, Size: 719 bytes --]

bug#25605: bug#25606: patches installed for 25605, 25606

[Paul Eggert]

On 02/07/2017 04:47 AM, Philipp Stephani wrote:
> If they fail, shouldn't the test runner that runs these tests time out 
> after some time and mark them as failures? 

Not if the test runner is written in elisp. The loops are deep in the C 
code and are immune to elisp timeouts. (I don't know how the test runner 
works.)

bug#25605: bug#25606: patches installed for 25605, 25606

[Philipp Stephani]

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

Paul Eggert <eggert@cs.ucla.edu> schrieb am Di., 7. Feb. 2017 um 17:32 Uhr:

> On 02/07/2017 04:47 AM, Philipp Stephani wrote:
> > If they fail, shouldn't the test runner that runs these tests time out
> > after some time and mark them as failures?
>
> Not if the test runner is written in elisp. The loops are deep in the C
> code and are immune to elisp timeouts. (I don't know how the test runner
> works.)
>
>
How about running the Emacs binary wrapped in /usr/bin/timeout?

[-- Attachment #2: Type: text/html, Size: 932 bytes --]

bug#25606: patches installed for 25605, 25606

[Paul Eggert]

On 02/07/2017 01:47 PM, Philipp Stephani wrote:
> How about running the Emacs binary wrapped in /usr/bin/timeout?

That should work on GNU platforms. 'timeout' is not a standard program, 
though, and we can't rely on its presence on non-GNU platforms.

bug#25606: patches installed for 25605, 25606

[Philipp Stephani]

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

Paul Eggert <eggert@cs.ucla.edu> schrieb am Di., 7. Feb. 2017 um 23:20 Uhr:

> On 02/07/2017 01:47 PM, Philipp Stephani wrote:
> > How about running the Emacs binary wrapped in /usr/bin/timeout?
>
> That should work on GNU platforms. 'timeout' is not a standard program,
> though, and we can't rely on its presence on non-GNU platforms.
>
>
This is only for running tests; don't we already require autotools for that
as well? We could also check for it in configure using AC_CHECK_PROGS.

[-- Attachment #2: Type: text/html, Size: 905 bytes --]

bug#25605: bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org, 25605@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Mon, 6 Feb 2017 22:53:35 -0800
> 
> Eli Zaretskii wrote:
> > Any reasons why the tests are in manual/cyclic-tests.el, and not in
> > src/fns-tests.el?
> 
> No particular reason, no. I don't know my way around the test directories well; 
> please feel free to move them.

Done.  I took the liberty to do the commit in your name, to keep the
attribution of the code to the original author.

Btw, 3 of the new tests fail for me:

  Test test-cycle-lax-plist-get backtrace:
    (setq value-1366 (apply fn-1364 args-1365))
    (unwind-protect (setq value-1366 (apply fn-1364 args-1365)) (setq fo
    (not (unwind-protect (setq value-1366 (apply fn-1364 args-1365)) (se
    (if (not (unwind-protect (setq value-1366 (apply fn-1364 args-1365))
    (let (form-description-1368) (if (not (unwind-protect (setq value-13
    (let ((value-1366 (quote ert-form-evaluation-aborted-1367))) (let (f
    (let ((fn-1364 (function lax-plist-get)) (args-1365 (list d1 2))) (l
    (let ((c1 (cyc1 1)) (c2 (cyc2 1 2)) (d1 (dot1 1)) (d2 (dot2 1 2))) (
    (lambda nil (let ((c1 (cyc1 1)) (c2 (cyc2 1 2)) (d1 (dot1 1)) (d2 (d
    ert--run-test-internal([cl-struct-ert--test-execution-info [cl-struc
    ert-run-test([cl-struct-ert-test test-cycle-lax-plist-get nil (lambd
    ert-run-or-rerun-test([cl-struct-ert--stats t [[cl-struct-ert-test f
    ert-run-tests(t #[385 "\306☻\307\"\203G \211\211G\310U\203¶ \211@\20
    ert-run-tests-batch(nil)
    ert-run-tests-batch-and-exit(nil)
    eval((ert-run-tests-batch-and-exit nil))
    command-line-1(("-L" ";." "-l" "ert" "-l" "src/fns-tests.el" "--eval
    command-line()
    normal-top-level()
  Test test-cycle-lax-plist-get condition:
      (wrong-type-argument listp
			   (1 1 1 1 1 1 1 1 1 1 . tail))
     FAILED  18/31  test-cycle-lax-plist-get
  Test test-cycle-lax-plist-put backtrace:
    (setq value-1570 (apply fn-1568 args-1569))
    (unwind-protect (setq value-1570 (apply fn-1568 args-1569)) (setq fo
    (if (unwind-protect (setq value-1570 (apply fn-1568 args-1569)) (set
    (let (form-description-1572) (if (unwind-protect (setq value-1570 (a
    (let ((value-1570 (quote ert-form-evaluation-aborted-1571))) (let (f
    (let ((fn-1568 (function lax-plist-put)) (args-1569 (list d1 2 2)))
    (let ((c1 (cyc1 1)) (c2 (cyc2 1 2)) (d1 (dot1 1)) (d2 (dot2 1 2))) (
    (lambda nil (let ((c1 (cyc1 1)) (c2 (cyc2 1 2)) (d1 (dot1 1)) (d2 (d
    ert--run-test-internal([cl-struct-ert--test-execution-info [cl-struc
    ert-run-test([cl-struct-ert-test test-cycle-lax-plist-put nil (lambd
    ert-run-or-rerun-test([cl-struct-ert--stats t [[cl-struct-ert-test f
    ert-run-tests(t #[385 "\306☻\307\"\203G \211\211G\310U\203¶ \211@\20
    ert-run-tests-batch(nil)
    ert-run-tests-batch-and-exit(nil)
    eval((ert-run-tests-batch-and-exit nil))
    command-line-1(("-L" ";." "-l" "ert" "-l" "src/fns-tests.el" "--eval
    command-line()
    normal-top-level()
  Test test-cycle-lax-plist-put condition:
      (wrong-type-argument listp
			   (1 1 1 1 1 1 1 1 1 1 . tail))
     FAILED  19/31  test-cycle-lax-plist-put
     passed  20/31  test-cycle-length
     passed  21/31  test-cycle-member
     passed  22/31  test-cycle-memq
     passed  23/31  test-cycle-memql
     passed  24/31  test-cycle-nconc
     passed  25/31  test-cycle-plist-get
     passed  26/31  test-cycle-plist-member
  Test test-cycle-plist-put backtrace:
    (setq value-1504 (apply fn-1502 args-1503))
    (unwind-protect (setq value-1504 (apply fn-1502 args-1503)) (setq fo
    (if (unwind-protect (setq value-1504 (apply fn-1502 args-1503)) (set
    (let (form-description-1506) (if (unwind-protect (setq value-1504 (a
    (let ((value-1504 (quote ert-form-evaluation-aborted-1505))) (let (f
    (let ((fn-1502 (function plist-put)) (args-1503 (list d1 2 2))) (let
    (let ((c1 (cyc1 1)) (c2 (cyc2 1 2)) (d1 (dot1 1)) (d2 (dot2 1 2))) (
    (lambda nil (let ((c1 (cyc1 1)) (c2 (cyc2 1 2)) (d1 (dot1 1)) (d2 (d
    ert--run-test-internal([cl-struct-ert--test-execution-info [cl-struc
    ert-run-test([cl-struct-ert-test test-cycle-plist-put nil (lambda ni
    ert-run-or-rerun-test([cl-struct-ert--stats t [[cl-struct-ert-test f
    ert-run-tests(t #[385 "\306☻\307\"\203G \211\211G\310U\203¶ \211@\20
    ert-run-tests-batch(nil)
    ert-run-tests-batch-and-exit(nil)
    eval((ert-run-tests-batch-and-exit nil))
    command-line-1(("-L" ";." "-l" "ert" "-l" "src/fns-tests.el" "--eval
    command-line()
    normal-top-level()
  Test test-cycle-plist-put condition:
      (wrong-type-argument listp
			   (1 1 1 1 1 1 1 1 1 1 . tail))
     FAILED  27/31  test-cycle-plist-put
     passed  28/31  test-cycle-rassoc
     passed  29/31  test-cycle-rassq
     passed  30/31  test-cycle-reverse
     passed  31/31  test-cycle-safe-length

  Ran 31 tests, 28 results as expected, 3 unexpected (2017-02-10 11:49:19+0200)

bug#25606: patches installed for 25605, 25606

[Paul Eggert]

Eli Zaretskii wrote:
> I took the liberty to do the commit in your name, to keep the
> attribution of the code to the original author.
>
> Btw, 3 of the new tests fail for me:

Although the new tests fail for me too, they succeed if I revert commit 
65298ff4d5861cbc8d88162d58c18fa972b81acf, i.e., the commit that you installed in 
my name. So there must be something wrong with that commit. It would be easy to 
revert the commit but I assume that it was done for a reason so I'll wait for 
you to look into the problem.

bug#25605: bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org, 25605@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sun, 12 Feb 2017 00:31:02 -0800
> 
> Eli Zaretskii wrote:
> > I took the liberty to do the commit in your name, to keep the
> > attribution of the code to the original author.
> >
> > Btw, 3 of the new tests fail for me:
> 
> Although the new tests fail for me too, they succeed if I revert commit 
> 65298ff4d5861cbc8d88162d58c18fa972b81acf, i.e., the commit that you installed in 
> my name. So there must be something wrong with that commit.

That's strange.  Before pushing, I verified that I get the same
failures with your original test file.  But maybe I didn't invoke the
test as you intended it to be run.  Here's how I invoke it:

  $ cd test && ../src/emacs -batch -l ert -l manual/cycle-tests.el --eval "(ert-run-tests-batch-and-exit nil)"

If that's wrong, what is the right way of running those tests?

bug#25606: patches installed for 25605, 25606

[Paul Eggert]

Eli Zaretskii wrote:
> what is the right way of running those tests?

"make check". That's what's documented, right?

bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org, 25605@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sun, 12 Feb 2017 10:55:00 -0800
> 
> Eli Zaretskii wrote:
> > what is the right way of running those tests?
> 
> "make check". That's what's documented, right?

This runs everything, which is too much.  How do I run this single
test?  (AFAIU, it runs each test exactly as I did.)

bug#25605: bug#25606: patches installed for 25605, 25606

[Lars Ingebrigtsen]

Eli Zaretskii <eliz@gnu.org> writes:

>> "make check". That's what's documented, right?
>
> This runs everything, which is too much.  How do I run this single
> test?  (AFAIU, it runs each test exactly as I did.)

I don't know how to do a single test, but I always run tests from a
single file like so:

larsi@mouse:~/src/emacs/trunk/test$ make src/fns-tests

(which hangs for me at present).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#25606: bug#25605: bug#25606: patches installed for 25605, 25606

[Lars Ingebrigtsen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> larsi@mouse:~/src/emacs/trunk/test$ make src/fns-tests
>
> (which hangs for me at present).

(Hm, doesn't hang after rebuilding Emacs.  But some of the tests fail.)

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#25605: bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> From: Lars Ingebrigtsen <larsi@gnus.org>
> Cc: Paul Eggert <eggert@cs.ucla.edu>,  25605@debbugs.gnu.org,  25606@debbugs.gnu.org
> Date: Sun, 12 Feb 2017 20:41:16 +0100
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> "make check". That's what's documented, right?
> >
> > This runs everything, which is too much.  How do I run this single
> > test?  (AFAIU, it runs each test exactly as I did.)
> 
> I don't know how to do a single test, but I always run tests from a
> single file like so:
> 
> larsi@mouse:~/src/emacs/trunk/test$ make src/fns-tests

That's what I do.  But this doesn't work for files in manual/.

> (which hangs for me at present).

(It doesn't hang for me; it fails because 3 tests fail.)

bug#25606: patches installed for 25605, 25606

[Paul Eggert]

Eli Zaretskii wrote:
> This runs everything, which is too much.  How do I run this single
> test?

Sorry, I don't know. I didn't have to know, as "make check" sufficed for me.

bug#25606: patches installed for 25605, 25606

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> > what is the right way of running those tests?
>> 
>> "make check". That's what's documented, right?
>
> This runs everything, which is too much.  How do I run this single
> test?  (AFAIU, it runs each test exactly as I did.)

# make -C test fns-tests SELECTOR=\'test-cycle-lax-plist-get

See also test/README

Best regards, Michael.

bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: Paul Eggert <eggert@cs.ucla.edu>,  25605@debbugs.gnu.org,  25606@debbugs.gnu.org
> Date: Mon, 13 Feb 2017 10:11:21 +0100
> 
> >> "make check". That's what's documented, right?
> >
> > This runs everything, which is too much.  How do I run this single
> > test?  (AFAIU, it runs each test exactly as I did.)
> 
> # make -C test fns-tests SELECTOR=\'test-cycle-lax-plist-get

Yes, I know.  But that doesn't work for tests under manual/, which is
what I was asking about.

bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org, 25605@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sun, 12 Feb 2017 10:55:00 -0800
> 
> Eli Zaretskii wrote:
> > what is the right way of running those tests?
> 
> "make check". That's what's documented, right?

Actually, AFAIU "make check" doesn't run the tests in manual/ at all,
so I'm not sure how you succeeded to run them.  Or maybe I'm missing
something obvious.

bug#25605: bug#25606: patches installed for 25605, 25606

[Paul Eggert]

Eli Zaretskii wrote:
> Actually, AFAIU "make check" doesn't run the tests in manual/ at all,
> so I'm not sure how you succeeded to run them.

Well, now that I think back on it, I'm not sure either. I did run them, using 
some complicated set of arguments to 'make', but I don't remember what the 
arguments were.

Anyway, I debugged the tests under the new regime and installed a fix.

bug#25606: patches installed for 25605, 25606

[Eli Zaretskii]

> Cc: 25606@debbugs.gnu.org, 25605@debbugs.gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sun, 12 Feb 2017 12:57:13 -0800
> 
> Anyway, I debugged the tests under the new regime and installed a fix.

Thanks, they all pass for me now.