# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1290004646 0
# Node ID cde1608596d0b70c29939d8f4701299c3cf4aa1e
# Parent  09fed7053634cd8ab9c1a79add8533ac93d8023d
Handle bignum N correctly, #'butlast, #'nbutlast.

2010-11-17  Aidan Kehoe  <kehoea@parhasard.net>

	* fns.c (bignum_butlast): New.
	(Fnbutlast, Fbutlast): Use it.
	In #'butlast and #'nbutlast, if N is a bignum, we should always
	return nil. Bug revealed by Paul Dietz' test suite, thank you
	Paul.

diff -r 09fed7053634 -r cde1608596d0 src/ChangeLog
--- a/src/ChangeLog	Wed Nov 17 14:30:03 2010 +0000
+++ b/src/ChangeLog	Wed Nov 17 14:37:26 2010 +0000
@@ -1,3 +1,11 @@
+2010-11-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (bignum_butlast): New.
+	(Fnbutlast, Fbutlast): Use it.
+	In #'butlast and #'nbutlast, if N is a bignum, we should always
+	return nil. Bug revealed by Paul Dietz' test suite, thank you
+	Paul.
+
 2010-11-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* .gdbinit.in: Remove lrecord_type_popup_data,
diff -r 09fed7053634 -r cde1608596d0 src/fns.c
--- a/src/fns.c	Wed Nov 17 14:30:03 2010 +0000
+++ b/src/fns.c	Wed Nov 17 14:37:26 2010 +0000
@@ -1576,6 +1576,9 @@
   return retval;
 }
 
+static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number,
+                                   Boolint copy);
+
 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
 Modify LIST to remove the last N (default 1) elements.
 
@@ -1590,6 +1593,11 @@
 
   if (!NILP (n))
     {
+      if (BIGNUMP (n))
+        {
+          return bignum_butlast (list, n, 0);
+        }
+
       CHECK_NATNUM (n);
       int_n = XINT (n);
     }
@@ -1638,6 +1646,11 @@
 
   if (!NILP (n))
     {
+      if (BIGNUMP (n))
+        {
+          return bignum_butlast (list, n, 1);
+        }
+
       CHECK_NATNUM (n);
       int_n = XINT (n);
     }
@@ -1673,6 +1686,42 @@
   return retval;
 }
 
+/* This is sufficient to implement #'butlast and #'nbutlast with bignum N
+   under XEmacs, because #'list-length and #'safe-length can never return a
+   bignum. This means that #'nbutlast never has to modify and #'butlast
+   never has to copy. */
+static Lisp_Object
+bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy)
+{
+  Boolint malformed = EQ (Fsafe_length (list), Qzero);
+  Boolint circular = !malformed && EQ (Flist_length (list), Qnil);
+
+  assert (BIGNUMP (number));
+
+#ifdef HAVE_BIGNUM
+
+  if (bignum_sign (XBIGNUM_DATA (number)) < 0)
+    {
+      dead_wrong_type_argument (Qnatnump, number);
+    }
+
+  number = Fcanonicalize_number (number);
+
+  if (INTP (number))
+    {
+      return copy ? Fbutlast (list, number) : Fnbutlast (list, number);
+    }
+
+#endif
+
+  if (circular)
+    {
+      signal_circular_list_error (list);
+    }
+
+  return Qnil;
+}
+
 DEFUN ("member", Fmember, 2, 2, 0, /*
 Return non-nil if ELT is an element of LIST.  Comparison done with `equal'.
 The value is actually the tail of LIST whose car is ELT.