X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=e27f5aeb2f6b5a340fa9c6d2b3867bc9835df8a4;hb=23a229276c2447a658b7a30217ec774067c27d5e;hp=d22342d512a09ac28e1f48465fdf66076948b234;hpb=697f4d1bd284ed6b72d24f416dfb09c2779b12df;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index d22342d..e27f5ae 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -129,6 +129,7 @@
 ;;; value-cells
 
 (defun-with-dx dx-value-cell (x)
+  (declare (optimize sb-c::stack-allocate-value-cells))
   ;; Not implemented everywhere, yet.
   #+(or x86 x86-64 mips)
   (let ((cell x))
@@ -146,6 +147,14 @@
     (true cons)
     nil))
 
+;;; MAKE-ARRAY
+
+(defun-with-dx make-array-on-stack ()
+  (let ((v (make-array '(42) :element-type 'single-float)))
+    (declare (dynamic-extent v))
+    (true v)
+    nil))
+
 ;;; Nested DX
 
 (defun-with-dx nested-dx-lists ()
@@ -240,6 +249,7 @@
   (assert-no-consing (test-lvar-subst 11))
   (assert-no-consing (dx-value-cell 13))
   (assert-no-consing (cons-on-stack 42))
+  (assert-no-consing (make-array-on-stack))
   (assert-no-consing (nested-dx-conses))
   (assert-no-consing (nested-dx-lists))
   (assert-consing (nested-dx-not-used *a-cons*))
@@ -289,6 +299,31 @@
   (let ((a (make-array 11 :initial-element 0)))
     (declare (dynamic-extent a))
     (assert (every (lambda (x) (eql x 0)) a))))
-(bdowning-2005-iv-16)
-
+(assert-no-consing (bdowning-2005-iv-16))
+
+
+(defun-with-dx let-converted-vars-dx-allocated-bug (x y z)
+  (let* ((a (list x y z))
+         (b (list x y z))
+         (c (list a b)))
+    (declare (dynamic-extent c))
+    (values (first c) (second c))))
+(multiple-value-bind (i j) (let-converted-vars-dx-allocated-bug 1 2 3)
+  (assert (and (equal i j)
+               (equal i (list 1 2 3)))))
+
+;;; workaround for bug 419 -- real issue remains, but check that the
+;;; bandaid holds.
+(defun-with-dx bug419 (x)
+  (multiple-value-call #'list
+    (eval '(values 1 2 3))
+    (let ((x x))
+      (declare (dynamic-extent x))
+      (flet ((mget (y)
+               (+ x y))
+             (mset (z)
+               (incf x z)))
+        (declare (dynamic-extent #'mget #'mset))
+        ((lambda (f g) (eval `(progn ,f ,g (values 4 5 6)))) #'mget #'mset)))))
+(assert (equal (bug419 42) '(1 2 3 4 5 6)))