Use AMOP representation of canonicalized default initargs for conditions

[sbcl.git] / tests / dynamic-extent.impure.lisp

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 6c83f8a..3a227eb 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -21,8 +21,17 @@
       sb-ext:*stack-allocate-dynamic-extent* t)
 
 (defmacro defun-with-dx (name arglist &body body)
-  `(defun ,name ,arglist
-     ,@body))
+  (let ((debug-name (sb-int:symbolicate name "-HIGH-DEBUG"))
+        (default-name (sb-int:symbolicate name "-DEFAULT")))
+    `(progn
+       (defun ,debug-name ,arglist
+         (declare (optimize debug))
+         ,@body)
+       (defun ,default-name ,arglist
+        ,@body)
+       (defun ,name (&rest args)
+         (apply #',debug-name args)
+         (apply #',default-name args)))))
 
 (declaim (notinline opaque-identity))
 (defun opaque-identity (x)
@@ -682,7 +691,7 @@
   (bdowning-2005-iv-16))
 
 (declaim (inline my-nconc))
-(defun-with-dx my-nconc (&rest lists)
+(defun my-nconc (&rest lists)
   (declare (dynamic-extent lists))
   (apply #'nconc lists))
 (defun-with-dx my-nconc-caller (a b c)
@@ -1089,3 +1098,11 @@
     (assert (every (lambda (x)
                      (sb-sys:sap= x (sb-sys:int-sap (+ 16 (ash 1 (1- width))))))
                    (funcall f (sb-sys:int-sap (ash 1 (1- width))))))))
+
+(with-test (:name :&more-bounds)
+  ;; lp#1154946
+  (assert (not (funcall (compile nil '(lambda (&rest args) (car args))))))
+  (assert (not (funcall (compile nil '(lambda (&rest args) (nth 6 args))))))
+  (assert (not (funcall (compile nil '(lambda (&rest args) (elt args 10))))))
+  (assert (not (funcall (compile nil '(lambda (&rest args) (cadr args))))))
+  (assert (not (funcall (compile nil '(lambda (&rest args) (third args)))))))