Mercurial > hg > xemacs-beta

changeset 5471:00e79bbbe48f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 14 Feb 2011 22:43:46 +0100
parents 0af042a0c116 (current diff) 5dd1ba5e0113 (diff)
children e79980ee5efe
files lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el lisp/cl.el src/ChangeLog src/alloc.c src/faces.c src/fns.c src/lisp.h src/mc-alloc.c tests/ChangeLog tests/automated/lisp-tests.el
diffstat 12 files changed, 160 insertions(+), 104 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Feb 07 21:22:17 2011 +0100
+++ b/lisp/ChangeLog	Mon Feb 14 22:43:46 2011 +0100
@@ -1,3 +1,30 @@
+2011-02-12  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el:
+	* bytecomp.el (byte-compile-initial-macro-environment):
+	* bytecomp.el (unwind-protect):
+	* bytecomp.el (byte-compile-active-blocks):
+	* bytecomp.el (byte-compile-catch):
+	* bytecomp.el ('return-from-1): Removed.
+	* bytecomp.el ('block-1): Removed.
+	* bytecomp.el (byte-compile-block-1): Removed.
+	* bytecomp.el (byte-compile-return-from-1): Removed.
+	* bytecomp.el (byte-compile-throw):
+	* cl-macs.el (block):
+	* cl-macs.el (return-from):
+	In my last change, the elimination of `block's that were never
+	`return-from'd didn't work if `cl-macroexpand-all' was called
+	explicitly, something much code in cl-macs.el does.  Change the
+	implementation to something that doesn't require shadowing of the
+	macros in `byte-compile-initial-macro-environment', putting a
+	`cl-block-name' property on the gensym'd symbol argument to
+	`catch' instead.
+
+2011-02-09  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl.el (acons): Removed, make the implementation in alloc.c
+	visible to Lisp instead.
+
 2011-02-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* bytecomp.el:
--- a/lisp/bytecomp.el	Mon Feb 07 21:22:17 2011 +0100
+++ b/lisp/bytecomp.el	Mon Feb 14 22:43:46 2011 +0100
@@ -509,11 +509,7 @@
 		    "%s is not of type %s" form type)))
 	   (if byte-compile-delete-errors
 	       form
-	     (funcall (cdr (symbol-function 'the)) type form))))
-    (return-from .
-      ,#'(lambda (name &optional result) `(return-from-1 ',name ,result)))
-    (block .
-      ,#'(lambda (name &rest body) `(block-1 ',name ,@body))))
+	     (funcall (cdr (symbol-function 'the)) type form)))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -4184,8 +4180,6 @@
 ;;; other tricky macro-like special-operators
 
 (byte-defop-compiler-1 catch)
-(byte-defop-compiler-1 block-1)
-(byte-defop-compiler-1 return-from-1)
 (byte-defop-compiler-1 unwind-protect)
 (byte-defop-compiler-1 condition-case)
 (byte-defop-compiler-1 save-excursion)
@@ -4194,44 +4188,33 @@
 (byte-defop-compiler-1 with-output-to-temp-buffer)
 ;; no track-mouse.
 
+(defvar byte-compile-active-blocks nil)
+
 (defun byte-compile-catch (form)
-  (byte-compile-form (car (cdr form)))
-  (byte-compile-push-constant
-    (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
-  (byte-compile-out 'byte-catch 0))
-
-;; `return-from' and `block' are different from `throw' and `catch' when it
-;; comes to scope and extent. These differences are implemented for
-;; interpreted code in cl-macs.el, in compiled code in bytecomp.el. There's
-;; a certain amount of bootstrapping needed for the latter, and until this
-;; is done return-from and block behave as throw and catch in their scope
-;; and extent. This is only relevant to people working on bytecomp.el.
-
-(defalias 'return-from-1 'throw)
-(defalias 'block-1 'catch)
-
-(defvar byte-compile-active-blocks nil)
-
-(defun byte-compile-block-1 (form)
-  (let* ((name (nth 1 (nth 1 form)))
-	 (elt (list name (copy-symbol name) nil))
-	 (byte-compile-active-blocks (cons elt byte-compile-active-blocks))
-	 (body (byte-compile-top-level (cons 'progn (cddr form)))))
-    (if (nth 2 elt)
-	(byte-compile-catch `(catch ',(nth 1 elt) ,body))
-      (byte-compile-form body))))
-
-(defun byte-compile-return-from-1 (form)
-  (let* ((name (nth 1 (nth 1 form)))
-	 (assq (assq name byte-compile-active-blocks)))
-    (if assq
-	(setf (nth 2 assq) t)
-      (byte-compile-warn
-       "return-from: %S: no current lexical block with this name"
-       name))
-    (byte-compile-throw
-     `(throw ',(or (nth 1 assq) (copy-symbol name))
-             ,@(nthcdr 2 form)))))
+  "Byte-compile and return a `catch' from.
+
+If FORM is the result of macroexpanding a `block' form (the TAG argument is
+a quoted symbol with a non-nil `cl-block-name' property) and there is no
+corresponding `return-from' within the block--or equivalently, it was
+optimized away--just byte compile and return the BODY."
+  (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
+	 (block (and symbol (symbolp symbol) (get symbol 'cl-block-name)))
+	 (elt (and block (cons block nil)))
+	 (byte-compile-active-blocks
+	  (if block
+	      (cons elt byte-compile-active-blocks)
+	    byte-compile-active-blocks))
+	 (body
+	  (byte-compile-top-level (cons 'progn (cddr form))
+				  (if block nil for-effect))))
+    (if (and block (not (cdr elt)))
+	;; A lexical block without any contained return-from clauses:
+	(byte-compile-form body)
+      ;; A normal catch call, or a lexical block with a contained
+      ;; return-from clause.
+      (byte-compile-form (car (cdr form)))
+      (byte-compile-push-constant body)
+      (byte-compile-out 'byte-catch 0))))
 
 (defun byte-compile-unwind-protect (form)
   (byte-compile-push-constant
@@ -4381,6 +4364,12 @@
         (byte-compile-normal-call
          `(signal 'wrong-number-of-arguments '(,(car form)
                                                ,(length (cdr form))))))
+    ;; If this form was macroexpanded from `return-from', mark the
+    ;; corresponding block as having been referenced.
+    (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
+	   (block (and symbol (symbolp symbol) (get symbol 'cl-block-name)))
+	   (assq (and block (assq block byte-compile-active-blocks))))
+      (and assq (setcdr assq t)))
     (byte-compile-form (nth 1 form))  ;; Push the arguments
     (byte-compile-form (nth 2 form))
     (byte-compile-out (get (car form) 'byte-opcode) 0)
--- a/lisp/cl-macs.el	Mon Feb 07 21:22:17 2011 +0100
+++ b/lisp/cl-macs.el	Mon Feb 14 22:43:46 2011 +0100
@@ -745,6 +745,9 @@
   (let ((cl-active-block-names (acons name (copy-symbol name)
 				      cl-active-block-names))
 	(body (cons 'progn body)))
+    ;; Tell the byte-compiler this is a block, not a normal catch call, and
+    ;; as such it can eliminate it if that's appropriate:
+    (put (cdar cl-active-block-names) 'cl-block-name name)
     `(catch ',(cdar cl-active-block-names)
       ,(cl-macroexpand-all body cl-macro-environment))))
 
@@ -761,8 +764,13 @@
 returning RESULT from that form (or nil if RESULT is omitted).
 This is compatible with Common Lisp, but note that `defun' and
 `defmacro' do not create implicit blocks as they do in Common Lisp."
-  `(throw ',(or (cdr (assq name cl-active-block-names)) (copy-symbol name))
-	  ,result))
+  `(throw ',(or (cdr (assq name cl-active-block-names))
+		(prog1 (copy-symbol name)
+		  (and-fboundp 'byte-compile-warn (cl-compiling-file)
+			       (byte-compile-warn
+				"return-from: no enclosing block named `%s'"
+				name))))
+	 ,result))
 
 ;;; The "loop" macro.
 
--- a/lisp/cl.el	Mon Feb 07 21:22:17 2011 +0100
+++ b/lisp/cl.el	Mon Feb 14 22:43:46 2011 +0100
@@ -542,9 +542,7 @@
 (defalias 'cl-round 'round*)
 (defalias 'cl-mod 'mod*)
 
-(defun acons (key value alist)
-  "Return a new alist created by adding (KEY . VALUE) to ALIST."
-  (cons (cons key value) alist))
+;;; XEmacs; #'acons is in C.
 
 (defun pairlis (keys values &optional alist)
   "Make an alist from KEYS and VALUES.
--- a/src/ChangeLog	Mon Feb 07 21:22:17 2011 +0100
+++ b/src/ChangeLog	Mon Feb 14 22:43:46 2011 +0100
@@ -1,3 +1,20 @@
+2011-02-10  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (shortest_length_among_sequences):
+	This was buggy, it always errored if the last argument was
+	circular, even if other arguments were non-circular. Correct that.
+
+2011-02-09  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* alloc.c (Facons):
+	* alloc.c (Fobject_memory_usage):
+	* alloc.c (syms_of_alloc):
+	* faces.c (complex_vars_of_faces):
+	* lisp.h:
+	* mc-alloc.c (Fmc_alloc_memory_usage):
+	Rename acons() to Facons(), make it visible to Lisp. Change uses
+	of the function in C accordingly.
+
 2011-02-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* keymap.c (describe_map_sort_predicate): Correct the order of
--- a/src/alloc.c	Mon Feb 07 21:22:17 2011 +0100
+++ b/src/alloc.c	Mon Feb 14 22:43:46 2011 +0100
@@ -1426,8 +1426,10 @@
   return Fcons (obj0, Fcons (obj1, obj2));
 }
 
-Lisp_Object
-acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist)
+DEFUN ("acons", Facons, 3, 3, 0, /*
+Return a new alist created by prepending (KEY . VALUE) to ALIST.
+*/
+       (key, value, alist))
 {
   return Fcons (Fcons (key, value), alist);
 }
@@ -4195,10 +4197,10 @@
   xzero (object_stats);
   lisp_object_storage_size (object, &object_stats);
 
-  val = acons (Qobject_actually_requested,
-	       make_int (object_stats.was_requested), val);
-  val = acons (Qobject_malloc_overhead,
-	       make_int (object_stats.malloc_overhead), val);
+  val = Facons (Qobject_actually_requested,
+		make_int (object_stats.was_requested), val);
+  val = Facons (Qobject_malloc_overhead,
+		make_int (object_stats.malloc_overhead), val);
   assert (!object_stats.dynarr_overhead);
   assert (!object_stats.gap_overhead);
 
@@ -4208,16 +4210,16 @@
       MAYBE_OBJECT_METH (object, memory_usage, (object, &gustats));
 
       val = Fcons (Qt, val);
-      val = acons (Qother_memory_actually_requested,
-		   make_int (gustats.u.was_requested), val);
-      val = acons (Qother_memory_malloc_overhead,
-		   make_int (gustats.u.malloc_overhead), val);
+      val = Facons (Qother_memory_actually_requested,
+		    make_int (gustats.u.was_requested), val);
+      val = Facons (Qother_memory_malloc_overhead,
+		    make_int (gustats.u.malloc_overhead), val);
       if (gustats.u.dynarr_overhead)
-	val = acons (Qother_memory_dynarr_overhead,
-		     make_int (gustats.u.dynarr_overhead), val);
+	val = Facons (Qother_memory_dynarr_overhead,
+		      make_int (gustats.u.dynarr_overhead), val);
       if (gustats.u.gap_overhead)
-	val = acons (Qother_memory_gap_overhead,
-		     make_int (gustats.u.gap_overhead), val);
+	val = Facons (Qother_memory_gap_overhead,
+		      make_int (gustats.u.gap_overhead), val);
       val = Fcons (Qnil, val);
 
       i = 0;
@@ -4228,7 +4230,7 @@
 	      val = Fcons (item, val);
 	    else
 	      {
-		val = acons (item, make_int (gustats.othervals[i]), val);
+		val = Facons (item, make_int (gustats.othervals[i]), val);
 		i++;
 	      }
 	  }
@@ -5699,6 +5701,7 @@
 
   DEFSUBR (Fcons);
   DEFSUBR (Flist);
+  DEFSUBR (Facons);
   DEFSUBR (Fvector);
   DEFSUBR (Fbit_vector);
   DEFSUBR (Fmake_byte_code);
--- a/src/faces.c	Mon Feb 07 21:22:17 2011 +0100
+++ b/src/faces.c	Mon Feb 14 22:43:46 2011 +0100
@@ -2264,22 +2264,22 @@
     Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
 
 #ifdef HAVE_GTK
-    fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qgtk), build_ascstring ("white"), bg_fb);
+    fg_fb = Facons (list1 (Qgtk), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qgtk), build_ascstring ("white"), bg_fb);
 #endif
 #ifdef HAVE_X_WINDOWS
-    fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qx), build_ascstring ("gray80"), bg_fb);
+    fg_fb = Facons (list1 (Qx), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qx), build_ascstring ("gray80"), bg_fb);
 #endif
 #ifdef HAVE_TTY
-    fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
-    bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
+    fg_fb = Facons (list1 (Qtty), Fvector (0, 0), fg_fb);
+    bg_fb = Facons (list1 (Qtty), Fvector (0, 0), bg_fb);
 #endif
 #ifdef HAVE_MS_WINDOWS
-    fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb);
-    fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmswindows), build_ascstring ("white"), bg_fb);
+    fg_fb = Facons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb);
+    fg_fb = Facons (list1 (Qmswindows), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qmswindows), build_ascstring ("white"), bg_fb);
 #endif
     set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
     set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
@@ -2517,22 +2517,22 @@
     /* We need to put something in there, or error checking gets
        #%!@#ed up before the styles are set, which override the
        fallbacks. */
-    fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb);
+    fg_fb = Facons (list1 (Qgtk), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb);
 #endif
 #ifdef HAVE_X_WINDOWS
-    fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qx), build_ascstring ("Gray80"), bg_fb);
+    fg_fb = Facons (list1 (Qx), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qx), build_ascstring ("Gray80"), bg_fb);
 #endif
 #ifdef HAVE_TTY
-    fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
-    bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
+    fg_fb = Facons (list1 (Qtty), Fvector (0, 0), fg_fb);
+    bg_fb = Facons (list1 (Qtty), Fvector (0, 0), bg_fb);
 #endif
 #ifdef HAVE_MS_WINDOWS
-    fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb);
-    fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb);
+    fg_fb = Facons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb);
+    fg_fb = Facons (list1 (Qmswindows), build_ascstring ("black"), fg_fb);
+    bg_fb = Facons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb);
 #endif
     set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
     set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
--- a/src/fns.c	Mon Feb 07 21:22:17 2011 +0100
+++ b/src/fns.c	Mon Feb 14 22:43:46 2011 +0100
@@ -7143,7 +7143,7 @@
 static Elemcount
 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
 {
-  Elemcount len = EMACS_INT_MAX;
+  Elemcount len = 1 + EMACS_INT_MAX;
   Lisp_Object length = Qnil;
   int i;
 
@@ -7165,7 +7165,7 @@
         }
     }
 
-  if (NILP (length))
+  if (len == 1 + EMACS_INT_MAX)
     {
       signal_circular_list_error (sequences[0]);
     }
--- a/src/lisp.h	Mon Feb 07 21:22:17 2011 +0100
+++ b/src/lisp.h	Mon Feb 14 22:43:46 2011 +0100
@@ -4273,6 +4273,7 @@
 /* Defined in alloc.c */
 MODULE_API EXFUN (Fcons, 2);
 MODULE_API EXFUN (Flist, MANY);
+MODULE_API EXFUN (Facons, 3);
 EXFUN (Fbit_vector, MANY);
 EXFUN (Fmake_byte_code, MANY);
 MODULE_API EXFUN (Fmake_list, 2);
@@ -4297,7 +4298,6 @@
 #ifndef NEW_GC
 void garbage_collect_1 (void);
 #endif /* not NEW_GC */
-MODULE_API Lisp_Object acons (Lisp_Object, Lisp_Object, Lisp_Object);
 MODULE_API Lisp_Object cons3 (Lisp_Object, Lisp_Object, Lisp_Object);
 MODULE_API Lisp_Object list1 (Lisp_Object);
 MODULE_API Lisp_Object list2 (Lisp_Object, Lisp_Object);
--- a/src/mc-alloc.c	Mon Feb 07 21:22:17 2011 +0100
+++ b/src/mc-alloc.c	Mon Feb 14 22:43:46 2011 +0100
@@ -1985,29 +1985,29 @@
   for (i = 0; i < N_FREE_PAGE_LISTS; i++) 
     if (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)) > 0)
       free_plhs = 
-	acons (make_int (PLH_SIZE (FREE_HEAP_PAGES(i))),
-	       list1 (make_int (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)))),
-	       free_plhs);
+	Facons (make_int (PLH_SIZE (FREE_HEAP_PAGES(i))),
+		list1 (make_int (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)))),
+		free_plhs);
 
   for (i = 0; i < N_USED_PAGE_LISTS; i++) 
     if (PLH_PAGE_COUNT (USED_HEAP_PAGES(i)) > 0)
       used_plhs = 
-	acons (make_int (PLH_SIZE (USED_HEAP_PAGES(i))),
-	       list5 (make_int (PLH_PAGE_COUNT (USED_HEAP_PAGES(i))),
-		      make_int (PLH_USED_CELLS (USED_HEAP_PAGES(i))),
-		      make_int (PLH_USED_SPACE (USED_HEAP_PAGES(i))),
-		      make_int (PLH_TOTAL_CELLS (USED_HEAP_PAGES(i))),
-		      make_int (PLH_TOTAL_SPACE (USED_HEAP_PAGES(i)))),
-	       used_plhs);
+	Facons (make_int (PLH_SIZE (USED_HEAP_PAGES(i))),
+		list5 (make_int (PLH_PAGE_COUNT (USED_HEAP_PAGES(i))),
+		       make_int (PLH_USED_CELLS (USED_HEAP_PAGES(i))),
+		       make_int (PLH_USED_SPACE (USED_HEAP_PAGES(i))),
+		       make_int (PLH_TOTAL_CELLS (USED_HEAP_PAGES(i))),
+		       make_int (PLH_TOTAL_SPACE (USED_HEAP_PAGES(i)))),
+		used_plhs);
 
   used_plhs =
-    acons (make_int (0),
-	   list5 (make_int (PLH_PAGE_COUNT(ARRAY_HEAP_PAGES)),
-		  make_int (PLH_USED_CELLS (ARRAY_HEAP_PAGES)),
-		  make_int (PLH_USED_SPACE (ARRAY_HEAP_PAGES)),
-		  make_int (PLH_TOTAL_CELLS (ARRAY_HEAP_PAGES)),
-		  make_int (PLH_TOTAL_SPACE (ARRAY_HEAP_PAGES))),
-	   used_plhs);
+    Facons (make_int (0),
+	    list5 (make_int (PLH_PAGE_COUNT(ARRAY_HEAP_PAGES)),
+		   make_int (PLH_USED_CELLS (ARRAY_HEAP_PAGES)),
+		   make_int (PLH_USED_SPACE (ARRAY_HEAP_PAGES)),
+		   make_int (PLH_TOTAL_CELLS (ARRAY_HEAP_PAGES)),
+		   make_int (PLH_TOTAL_SPACE (ARRAY_HEAP_PAGES))),
+	    used_plhs);
   
   for (i = 0; i < N_HEAP_SECTIONS; i++) {
     used_size += HEAP_SECTION(i).n_pages * PAGE_SIZE;
--- a/tests/ChangeLog	Mon Feb 07 21:22:17 2011 +0100
+++ b/tests/ChangeLog	Mon Feb 14 22:43:46 2011 +0100
@@ -1,3 +1,11 @@
+2011-02-10  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	* automated/lisp-tests.el (mapcar*):
+	If multiple SEQUENCE arguments are passed to #'mapcar*, and the
+	last one is circular while the others aren't, make sure that
+	#'mapcar* doesn't error.
+
 2011-02-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/lisp-tests.el	Mon Feb 07 21:22:17 2011 +0100
+++ b/tests/automated/lisp-tests.el	Mon Feb 14 22:43:46 2011 +0100
@@ -1044,6 +1044,12 @@
       (car y))
     x)))
 
+(Assert
+ (equal
+  (let ((list (list pi))) (mapcar* #'cons [1 2 3 4] (nconc list list)))
+  `((1 . ,pi) (2 . ,pi) (3 . ,pi) (4 . ,pi)))
+ "checking mapcar* behaves correctly when only one arg is circular")
+
 (Assert (eql
  (length (multiple-value-list
           (car (mapcar #'(lambda (argument) (floor argument)) (list pi e)))))