changeset 5283:be436ac36ba4

Don't share a counter when checking for circularity, list_merge(). src/ChangeLog addition: 2010-10-12 Aidan Kehoe <kehoea@parhasard.net> * fns.c (list_merge): Circularity checking here needs to be done independently for each list, they can't share a loop counter. Thank you for the bug report, Robert Pluim! tests/ChangeLog addition: 2010-10-12 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Make sure circularity checking with #'merge is sane.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 12 Oct 2010 18:14:12 +0100
parents dcc34e28cd84
children d27c1ee1943b
files src/ChangeLog src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
diffstat 4 files changed, 57 insertions(+), 20 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sun Oct 10 12:32:38 2010 +0100
+++ b/src/ChangeLog	Tue Oct 12 18:14:12 2010 +0100
@@ -1,3 +1,10 @@
+2010-10-12  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (list_merge):
+	Circularity checking here needs to be done independently for each
+	list, they can't share a loop counter. Thank you for the bug
+	report, Robert Pluim!
+
 2010-09-20  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* lisp.h (GET_DEFUN_LISP_OBJECT): Make the NEW_GC version of this
--- a/src/fns.c	Sun Oct 10 12:32:38 2010 +0100
+++ b/src/fns.c	Tue Oct 12 18:14:12 2010 +0100
@@ -2157,7 +2157,7 @@
   Lisp_Object l1, l2;
   Lisp_Object tortoises[2];
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-  int looped = 0;
+  int l1_count = 0, l2_count = 0;
 
   l1 = org_l1;
   l2 = org_l2;
@@ -2203,37 +2203,56 @@
 	  tem = l1;
 	  l1 = Fcdr (l1);
 	  org_l1 = l1;
+
+	  if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+	    {
+	      if (l1_count & 1)
+		{
+		  if (!CONSP (tortoises[0]))
+		    {
+		      mapping_interaction_error (Qmerge, tortoises[0]);
+		    }
+
+		  tortoises[0] = XCDR (tortoises[0]);
+		}
+
+	      if (EQ (org_l1, tortoises[0]))
+		{
+		  signal_circular_list_error (org_l1);
+		}
+	    }
 	}
       else
 	{
 	  tem = l2;
 	  l2 = Fcdr (l2);
 	  org_l2 = l2;
+
+	  if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+	    {
+	      if (l2_count & 1)
+		{
+		  if (!CONSP (tortoises[1]))
+		    {
+		      mapping_interaction_error (Qmerge, tortoises[1]);
+		    }
+
+		  tortoises[1] = XCDR (tortoises[1]);
+		}
+
+	      if (EQ (org_l2, tortoises[1]))
+		{
+		  signal_circular_list_error (org_l2);
+		}
+	    }
 	}
+
       if (NILP (tail))
 	value = tem;
       else
 	Fsetcdr (tail, tem);
+
       tail = tem;
-
-      if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
-        {
-          if (looped & 1)
-            {
-              tortoises[0] = XCDR (tortoises[0]);
-              tortoises[1] = XCDR (tortoises[1]); 
-            }
-
-          if (EQ (org_l1, tortoises[0]))
-            {
-              signal_circular_list_error (org_l1);
-            }
-
-          if (EQ (org_l2, tortoises[1]))
-            {
-              signal_circular_list_error (org_l2);
-            }
-        }
     }
 }
 
--- a/tests/ChangeLog	Sun Oct 10 12:32:38 2010 +0100
+++ b/tests/ChangeLog	Tue Oct 12 18:14:12 2010 +0100
@@ -1,3 +1,8 @@
+2010-10-12  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Make sure circularity checking with #'merge is sane.
+
 2010-08-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el	Sun Oct 10 12:32:38 2010 +0100
+++ b/tests/automated/lisp-tests.el	Tue Oct 12 18:14:12 2010 +0100
@@ -2409,4 +2409,10 @@
   (Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10")))))
 	  "checking symbol named \"2/10\" not eql to ratio 1/5 on read"))
 
+(let* ((count 0)
+       (list (map-into (make-list 2048 nil) #'(lambda () (decf count))))
+       (expected (append list '(1))))
+  (Assert (equal expected (merge 'list list '(1) #'<))
+	  "checking merge's circularity checks are sane"))
+
 ;;; end of lisp-tests.el