Fix deadlocks in GC on Windows.
[sbcl.git] / tests / dynamic-extent.impure.lisp
index 3a227eb..9b06fd7 100644 (file)
     (declare (dynamic-extent x))
     (unless (equalp (caar x) (make-nested-good :bar *bar*))
       (error "got ~S, wanted ~S" (caar x) (make-nested-good :bar *bar*)))
-    (caar x)))
+    ;; the NESTED instance itself *should* be DX!
+    (copy-nested (caar x))))
 
 (with-test (:name :conservative-nested-dx)
   ;; NESTED-BAD should not stack-allocate :BAR due to the SETF.
 
 (with-test (:name (:no-consing :dx-vectors) :skipped-on '(not :stack-allocatable-vectors))
   (assert-no-consing (force-make-array-on-stack 128))
-  (assert-no-consing (make-array-on-stack-1))
   (assert-no-consing (make-array-on-stack-2 5 '(1 2.0 3 4.0 5)))
   (assert-no-consing (make-array-on-stack-3 9 8 7))
   (assert-no-consing (make-array-on-stack-4))
             :fails-on :x86
             :skipped-on `(not (and :stack-allocatable-vectors
                                    :c-stack-is-control-stack)))
+  (assert-no-consing (make-array-on-stack-1))
   (assert-no-consing (make-array-on-stack-6))
   (assert-no-consing (make-array-on-stack-7))
   (assert-no-consing (make-array-on-stack-8))
 (with-test (:name (:no-consing :hash-tables) :fails-on '(and :ppc :sb-thread))
   (assert-no-consing (test-hash-table)))
 
+;;; Both with-pinned-objects and without-gcing should not cons
+
+(defun call-without-gcing (fun)
+  (sb-sys:without-gcing (funcall fun)))
+
+(defun call-with-pinned-object (fun obj)
+  (sb-sys:with-pinned-objects (obj)
+    (funcall fun obj)))
+
+(with-test (:name (:no-consing :without-gcing))
+  (assert-no-consing (call-without-gcing (lambda ()))))
+
+(with-test (:name (:no-consing :with-pinned-objects))
+  (assert-no-consing (call-with-pinned-object #'identity 42)))
+
 ;;; with-mutex should use DX and not cons
 
 (defvar *mutex* (sb-thread::make-mutex :name "mutexlock"))