X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=685ff6d5b926fe814b928ab78adff92f46b0028b;hb=5d5894082c39ca44da75d38859d669c7b2108f6a;hp=df9bf956f55821206156bba8f538de7353855b5c;hpb=cb534036e501667da3b229627bf5169d7fb5a01c;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index df9bf95..685ff6d 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -14,13 +14,12 @@
 (when (eq sb-ext:*evaluator-mode* :interpret)
   (sb-ext:quit :unix-status 104))
 
-(setq sb-c::*check-consistency* t)
+(setq sb-c::*check-consistency* t
+      sb-ext:*stack-allocate-dynamic-extent* t)
 
 (defmacro defun-with-dx (name arglist &body body)
-  `(locally
-     (declare (optimize sb-c::stack-allocate-dynamic-extent))
-     (defun ,name ,arglist
-       ,@body)))
+  `(defun ,name ,arglist
+     ,@body))
 
 (declaim (notinline opaque-identity))
 (defun opaque-identity (x)
@@ -129,11 +128,10 @@
 ;;; 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))
-    (declare (dynamic-extent cell))
+    (declare (sb-int:truly-dynamic-extent cell))
     (flet ((f ()
              (incf cell)))
       (declare (dynamic-extent #'f))
@@ -385,7 +383,8 @@
 ;;; handler-case and handler-bind should use DX internally
 
 (defun dx-handler-bind (x)
-  (handler-bind ((error (lambda (c) (break "OOPS: ~S caused ~S" x c)))
+  (handler-bind ((error
+                  (lambda (c) (break "OOPS: ~S caused ~S" x c)))
                  ((and serious-condition (not error))
                   #'(lambda (c) (break "OOPS2: ~S did ~S" x c))))
     (/ 2 x)))
@@ -397,7 +396,7 @@
                    (:no-error (res)
                      (1- res))))))
 
-;;; with-spinlock should use DX and not cons
+;;; with-spinlock and with-mutex should use DX and not cons
 
 (defvar *slock* (sb-thread::make-spinlock :name "slocklock"))
 
@@ -405,6 +404,12 @@
   (sb-thread::with-spinlock (*slock*)
     (true *slock*)))
 
+(defvar *mutex* (sb-thread::make-mutex :name "mutexlock"))
+
+(defun test-mutex ()
+  (sb-thread:with-mutex (*mutex*)
+    (true *mutex*)))
+
 ;;; not really DX, but GETHASH and (SETF GETHASH) should not cons
 
 (defvar *table* (make-hash-table))
@@ -466,7 +471,9 @@
   ;; Not strictly DX..
   (assert-no-consing (test-hash-table))
   #+sb-thread
-  (assert-no-consing (test-spinlock)))
+  (progn
+    (assert-no-consing (test-spinlock))
+    (assert-no-consing (test-mutex))))
 
 
 ;;; Bugs found by Paul F. Dietz