X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=a74c186bfa0ba533f924b6049a448036b75aea40;hb=dc38fdd88ed505af945ee951635b396e129edb28;hp=4e0b0770224eb74dd021c85a407ae127dd799384;hpb=56a2dbbb9d79a62db99cc4061e50fca74fcf907e;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 4e0b077..a74c186 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -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,18 +200,56 @@
                        :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 vector-on-stack (x y)
@@ -535,6 +576,16 @@
   (assert-no-consing (make-array-on-stack-5))
   (assert-no-consing (vector-on-stack :x :y)))
 
+(with-test (:name (:no-consing :specialized-dx-vectors)
+	    :fails-on '(and :sunos :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)))
+
 (with-test (:name (:no-consing :dx-raw-instances) :fails-on :ppc :skipped-on '(not :raw-instance-init-vops))
   (let (a b)
     (setf a 1.24 b 1.23d0)
@@ -550,18 +601,12 @@
   (gethash 5 *table*))
 
 ;; This fails on threaded PPC because the hash-table implementation
-;; uses recursive system spinlocks, which cons (see below for test
-;; (:no-consing :spinlock), which also fails on threaded PPC).
+;; uses recursive system locks, which cons (see below for test
+;; (:no-consing :lock), which also fails on threaded PPC).
 (with-test (:name (:no-consing :hash-tables) :fails-on '(and :ppc :sb-thread))
   (assert-no-consing (test-hash-table)))
 
-;;; with-spinlock and with-mutex should use DX and not cons
-
-(defvar *slock* (sb-thread::make-spinlock :name "slocklock"))
-
-(defun test-spinlock ()
-  (sb-thread::with-spinlock (*slock*)
-    (true *slock*)))
+;;; with-mutex should use DX and not cons
 
 (defvar *mutex* (sb-thread::make-mutex :name "mutexlock"))
 
@@ -571,10 +616,6 @@
 
 (with-test (:name (:no-consing :mutex) :fails-on :ppc :skipped-on '(not :sb-thread))
   (assert-no-consing (test-mutex)))
-
-(with-test (:name (:no-consing :spinlock) :fails-on :ppc :skipped-on '(not :sb-thread))
-  (assert-no-consing (test-spinlock)))
-
 
 
 ;;; Bugs found by Paul F. Dietz