X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=521e0a419b826e98dc0876aa734acccd28810308;hb=024389e7e3db268f535e36d883b4efc9d7ea0f65;hp=9e7732150c064b03a62b52e1a193c33f5488bc2e;hpb=091f0c20d4661994be7be4cc707c2aba4ef86418;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 9e77321..521e0a4 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -503,20 +503,25 @@
 
 (defvar *a-cons* (cons nil nil))
 
-#+(or x86 x86-64 alpha ppc sparc mips hppa)
 (progn
+  #+stack-allocatable-closures
   (assert-no-consing (dxclosure 42))
-  (assert-no-consing (dxlength 1 2 3))
-  (assert-no-consing (dxlength t t t t t t))
-  (assert-no-consing (dxlength))
-  (assert-no-consing (dxcaller 1 2 3 4 5 6 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))
+  #+stack-allocatable-lists
+  (progn
+    (assert-no-consing (dxlength 1 2 3))
+    (assert-no-consing (dxlength t t t t t t))
+    (assert-no-consing (dxlength))
+    (assert-no-consing (dxcaller 1 2 3 4 5 6 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 (nested-dx-lists))
+    (assert-consing (nested-dx-not-used *a-cons*))
+    (assert-no-consing (nested-evil-dx-used *a-cons*))
+    (assert-no-consing (multiple-dx-uses)))
   (assert-no-consing (dx-value-cell 13))
-  ;; Only for platforms with DX FIXED-ALLOC
-  #+(or hppa mips x86 x86-64)
+  #+stack-allocatable-fixed-objects
   (progn
     (assert-no-consing (cons-on-stack 42))
     (assert-no-consing (make-foo1-on-stack 123))
@@ -524,8 +529,7 @@
     (assert-no-consing (nested-dx-conses))
     (assert-no-consing (dx-handler-bind 2))
     (assert-no-consing (dx-handler-case 2)))
-  ;; Only for platforms with DX ALLOCATE-VECTOR
-  #+(or hppa mips x86 x86-64)
+  #+stack-allocatable-vectors
   (progn
     (assert-no-consing (force-make-array-on-stack 128))
     (assert-no-consing (make-array-on-stack-1))
@@ -540,10 +544,6 @@
   (#+raw-instance-init-vops assert-no-consing
    #-raw-instance-init-vops progn
    (make-foo3-on-stack))
-  (assert-no-consing (nested-dx-lists))
-  (assert-consing (nested-dx-not-used *a-cons*))
-  (assert-no-consing (nested-evil-dx-used *a-cons*))
-  (assert-no-consing (multiple-dx-uses))
   ;; Not strictly DX..
   (assert-no-consing (test-hash-table))
   #+sb-thread
@@ -780,4 +780,18 @@
     (assert-notes 0 `(lambda (other)
                        #'(lambda (s c n)
                            (ignore-errors (funcall other s c n)))))))
+
+;;; Stack allocating a value cell in HANDLER-CASE would blow up stack
+;;; in an unfortunate loop.
+(defun handler-case-eating-stack ()
+  (let ((sp nil))
+    (do ((n 0 (logand most-positive-fixnum (1+ n))))
+        ((>= n 1024))
+     (multiple-value-bind (value error) (ignore-errors)
+       (when (and value error) nil))
+      (if sp
+          (assert (= sp (sb-c::%primitive sb-c:current-stack-pointer)))
+          (setf sp (sb-c::%primitive sb-c:current-stack-pointer))))))
+(with-test (:name :handler-case-eating-stack)
+  (assert-no-consing (handler-case-eating-stack)))