X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=4eebf0f62c8fafbfc51a86cf9f685230a5071b2a;hb=b14aefb22fd710673b1a1005add3c0425713d2a0;hp=00c3b7eb93011b9e46fbd220ebd0fb1414ca206f;hpb=40bff32181a4d9b591ae2bac69bbee3bd77a82bc;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 00c3b7e..4eebf0f 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -12,7 +12,7 @@
 ;;;; more information.
 
 (when (eq sb-ext:*evaluator-mode* :interpret)
-  (sb-ext:quit :unix-status 104))
+  (sb-ext:exit :code 104))
 
 (load "compiler-test-util.lisp")
 (use-package :ctu)
@@ -176,12 +176,14 @@
   (let ((v (make-array (min n 1))))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-1 ()
   (let ((v (make-array '(42) :element-type 'single-float)))
     (declare (dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-2 (n x)
@@ -189,6 +191,7 @@
   (let ((v (make-array n :initial-contents x)))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-3 (x y z)
@@ -197,48 +200,63 @@
                        :element-type t :initial-contents x)))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-4 ()
   (let ((v (make-array 3 :initial-contents '(1 2 3))))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-5 ()
   (let ((v (make-array 3 :initial-element 12 :element-type t)))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-6 ()
   (let ((v (make-array 3 :initial-element 12 :element-type '(unsigned-byte 8))))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-7 ()
   (let ((v (make-array 3 :initial-element 12 :element-type '(signed-byte 8))))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-8 ()
   (let ((v (make-array 3 :initial-element 12 :element-type 'word)))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-9 ()
   (let ((v (make-array 3 :initial-element 12.0 :element-type 'single-float)))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
     nil))
 
 (defun-with-dx make-array-on-stack-10 ()
   (let ((v (make-array 3 :initial-element 12.0d0 :element-type 'double-float)))
     (declare (sb-int:truly-dynamic-extent v))
     (true v)
+    (true v)
+    nil))
+
+(defun-with-dx make-array-on-stack-11 ()
+  (let ((v (make-array (the integer (opaque-identity 3)) :initial-element 12.0d0 :element-type 'double-float)))
+    (declare (sb-int:truly-dynamic-extent v))
+    (true v)
+    (true v)
     nil))
 
 (defun-with-dx vector-on-stack (x y)
@@ -566,15 +584,18 @@
   (assert-no-consing (vector-on-stack :x :y)))
 
 (with-test (:name (:no-consing :specialized-dx-vectors)
+            :fails-on :x86
             :skipped-on `(not (and :stack-allocatable-vectors
                                    :c-stack-is-control-stack)))
   (assert-no-consing (make-array-on-stack-6))
   (assert-no-consing (make-array-on-stack-7))
   (assert-no-consing (make-array-on-stack-8))
   (assert-no-consing (make-array-on-stack-9))
-  (assert-no-consing (make-array-on-stack-10)))
+  (assert-no-consing (make-array-on-stack-10))
+  (assert-no-consing (make-array-on-stack-11)))
 
-(with-test (:name (:no-consing :dx-raw-instances) :fails-on :ppc :skipped-on '(not :raw-instance-init-vops))
+(with-test (:name (:no-consing :dx-raw-instances) :skipped-on '(or (not :raw-instance-init-vops)
+                                                                   (not (and :gencgc :c-stack-is-control-stack))))
   (let (a b)
     (setf a 1.24 b 1.23d0)
     (assert-no-consing (make-foo2-on-stack a b)))
@@ -855,7 +876,9 @@
                          nil)))
     (assert-notes 0 `(lambda (list)
                        (declare (optimize (space 0)))
-                       (sort list #'<)))
+                       (sort list (lambda (x y) ; shut unrelated notes up
+                                    (< (truly-the fixnum x)
+                                       (truly-the fixnum y))))))
     (assert-notes 0 `(lambda (other)
                        #'(lambda (s c n)
                            (ignore-errors (funcall other s c n)))))))