X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=6844273efa7b350178ed26fb82b6cae81934e114;hb=16a6592367eec7c5e9da668ec42fd260e7705b0c;hp=33c618684e6a3b6f7516eef3582a202c61558b0a;hpb=e39c00f137e71016e259c667dfe2aa628963b730;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 33c6186..6844273 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -39,9 +39,14 @@
 (defun-with-dx dxcaller (&rest rest)
   (declare (dynamic-extent rest))
   (callee rest))
-
 (assert (= (dxcaller 1 2 3 4 5 6 7) 22))
 
+(defun-with-dx dxcaller-align-1 (x &rest rest)
+  (declare (dynamic-extent rest))
+  (+ x (callee rest)))
+(assert (= (dxcaller-align-1 17 1 2 3 4 5 6 7) 39))
+(assert (= (dxcaller-align-1 17 1 2 3 4 5 6 7 8) 40))
+
 ;;; %NIP-VALUES
 (defun-with-dx test-nip-values ()
   (flet ((bar (x &rest y)
@@ -90,6 +95,22 @@
       (opaque-identity :bar)
       z)))
 
+;;; alignment
+(defvar *x*)
+(defun-with-dx test-alignment-dx-list (form)
+  (multiple-value-prog1 (eval form)
+    (let ((l (list 1 2 3 4)))
+      (declare (dynamic-extent l))
+      (setq *x* (copy-list l)))))
+(dotimes (n 64)
+  (let* ((res (loop for i below n collect i))
+         (form `(values ,@res)))
+    (assert (equal (multiple-value-list (test-alignment-dx-list form)) res))
+    (assert (equal *x* '(1 2 3 4)))))
+
+
+
+
 (defmacro assert-no-consing (form &optional times)
   `(%assert-no-consing (lambda () ,form ,times)))
 (defun %assert-no-consing (thunk &optional times)
@@ -100,7 +121,7 @@
       (funcall thunk))
     (assert (< (- (get-bytes-consed) before) times))))
 
-#+x86
+#+(or x86 x86-64 alpha ppc)
 (progn
   (assert-no-consing (dxlength 1 2 3))
   (assert-no-consing (dxlength t t t t t t))
@@ -109,8 +130,7 @@
   (assert-no-consing (test-nip-values))
   (assert-no-consing (test-let-var-subst1 17))
   (assert-no-consing (test-let-var-subst2 17))
-  (assert-no-consing (test-lvar-subst 11))
-  )
+  (assert-no-consing (test-lvar-subst 11)))
 
 
 ;;; Bugs found by Paul F. Dietz
@@ -127,5 +147,31 @@
         a)))
    'x 'y)
   'x))
+
+
+;;; other bugs
+
+;;; bug reported by Svein Ove Aas
+(defun svein-2005-ii-07 (x y)
+  (declare (optimize (speed 3) (space 2) (safety 0) (debug 0)))
+  (let ((args (list* y 1 2 x)))
+    (declare (dynamic-extent args))
+    (apply #'aref args)))
+(assert (eql
+         (svein-2005-ii-07
+          '(0)
+          #3A(((1 1 1) (1 1 1) (1 1 1))
+              ((1 1 1) (1 1 1) (4 1 1))
+              ((1 1 1) (1 1 1) (1 1 1))))
+         4))
+
+;;; bug reported by Brian Downing: stack-allocated arrays were not
+;;; filled with zeroes.
+(defun-with-dx bdowning-2005-iv-16 ()
+  (let ((a (make-array 11 :initial-element 0)))
+    (declare (dynamic-extent a))
+    (assert (every (lambda (x) (eql x 0)) a))))
+(bdowning-2005-iv-16)
+
 
 (sb-ext:quit :unix-status 104)