X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=ab00e06a043375a4128644feeb8e42a0c56fdb56;hb=ab5427d31da2bd95805cccc8e47b8f43d3dd606d;hp=76d2cf859177c97c97224dc04ceaf71e35c94542;hpb=4c81c652cdc32faefee1bccb84c3c9a7854e3edd;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 76d2cf8..ab00e06 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -550,18 +550,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 +565,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
@@ -993,3 +983,38 @@
       (assert (eql a 1))
       (assert (eql b 2))
       (assert (eql c 3)))))
+
+(defun opaque-funcall (function &rest arguments)
+  (apply function arguments))
+
+(with-test (:name :implicit-value-cells)
+  (flet ((test-it (type input output)
+           (let ((f (compile nil `(lambda (x)
+                                    (declare (type ,type x))
+                                    (flet ((inc ()
+                                             (incf x)))
+                                      (declare (dynamic-extent #'inc))
+                                      (list (opaque-funcall #'inc) x))))))
+             (assert (equal (funcall f input)
+                            (list output output))))))
+    (let ((width sb-vm:n-word-bits))
+      (test-it t (1- most-positive-fixnum) most-positive-fixnum)
+      (test-it `(unsigned-byte ,(1- width)) (ash 1 (- width 2)) (1+ (ash 1 (- width 2))))
+      (test-it `(signed-byte ,width) (ash -1 (- width 2)) (1+ (ash -1 (- width 2))))
+      (test-it `(unsigned-byte ,width) (ash 1 (1- width)) (1+ (ash 1 (1- width))))
+      (test-it 'single-float 3f0 4f0)
+      (test-it 'double-float 3d0 4d0)
+      (test-it '(complex single-float) #c(3f0 4f0) #c(4f0 4f0))
+      (test-it '(complex double-float) #c(3d0 4d0) #c(4d0 4d0)))))
+
+(with-test (:name :sap-implicit-value-cells)
+  (let ((f (compile nil `(lambda (x)
+                           (declare (type system-area-pointer x))
+                           (flet ((inc ()
+                                    (setf x (sb-sys:sap+ x 16))))
+                             (declare (dynamic-extent #'inc))
+                             (list (opaque-funcall #'inc) x)))))
+        (width sb-vm:n-machine-word-bits))
+    (assert (every (lambda (x)
+                     (sb-sys:sap= x (sb-sys:int-sap (+ 16 (ash 1 (1- width))))))
+                   (funcall f (sb-sys:int-sap (ash 1 (1- width))))))))