X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=e8a177a1799d246865d9c54bffe852b2bc684fa0;hb=82f9c527cb607ccd19e5b24261dfe9af7b1ba72e;hp=3bc23188e3ca6c0a1fa5a26df65765fdaddf2659;hpb=470f4115c1d2a0defaed7367f36a30f46e83b52b;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 3bc2318..e8a177a 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -540,7 +540,7 @@
   (assert-no-consing (vector-on-stack :x :y)))
 
 #+raw-instance-init-vops
-(with-test (:name (:no-consing :dx-raw-instances))
+(with-test (:name (:no-consing :dx-raw-instances) :fails-on :ppc)
   (let (a b)
     (setf a 1.24 b 1.23d0)
     (assert-no-consing (make-foo2-on-stack a b)))
@@ -554,7 +554,10 @@
   (setf (gethash 5 *table*) 13)
   (gethash 5 *table*))
 
-(with-test (:name (:no-consing :hash-tables))
+;; 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).
+(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
@@ -572,11 +575,11 @@
     (true *mutex*)))
 
 #+sb-thread
-(with-test (:name (:no-consing :mutex))
+(with-test (:name (:no-consing :mutex) :fails-on :ppc)
   (assert-no-consing (test-mutex)))
 
 #+sb-thread
-(with-test (:name (:no-consing :spinlock))
+(with-test (:name (:no-consing :spinlock) :fails-on :ppc)
   (assert-no-consing (test-spinlock)))
 
 
@@ -756,8 +759,10 @@
 (with-test (:name :length-and-words-packed-in-same-tn)
   (assert (= 1 (length-and-words-packed-in-same-tn -3))))
 
-(with-test (:name :handler-case-bogus-compiler-note)
-  (handler-bind ((compiler-note #'error))
+(with-test (:name :handler-case-bogus-compiler-note :fails-on :ppc)
+  (handler-bind
+      ((compiler-note (lambda (note)
+                        (error "compiler issued note ~S during test" note))))
     ;; Taken from SWANK, used to signal a bogus stack allocation
     ;; failure note.
     (compile nil
@@ -787,7 +792,7 @@
     v))
 (defun barvector (x y z)
   (make-array 3 :initial-contents (list x y z)))
-(with-test (:name :dx-compiler-notes)
+(with-test (:name :dx-compiler-notes :fails-on :ppc)
   (flet ((assert-notes (j lambda)
            (let ((n 0))
              (handler-bind ((compiler-note (lambda (c)
@@ -844,7 +849,7 @@
       (if sp
           (assert (= sp (sb-c::%primitive sb-c:current-stack-pointer)))
           (setf sp (sb-c::%primitive sb-c:current-stack-pointer))))))
-(with-test (:name :handler-case-eating-stack)
+(with-test (:name :handler-case-eating-stack :fails-on :ppc)
   (assert-no-consing (handler-case-eating-stack)))
 
 ;;; A nasty bug where RECHECK-DYNAMIC-EXTENT-LVARS thought something was going
@@ -862,7 +867,7 @@
     (let ((vec (vec (aref vec 0) (aref vec 1) (aref vec 2))))
       (declare (dynamic-extent vec))
       (funcall fun vec))))
-(with-test (:name :recheck-nested-dx-bug)
+(with-test (:name :recheck-nested-dx-bug :fails-on :ppc)
   (assert (funcall (bad-boy (vec 1.0 2.0 3.3))
                    (lambda (vec) (equalp vec (vec 1.0 2.0 3.3)))))
   (flet ((foo (x) (declare (ignore x))))
@@ -889,4 +894,22 @@
              (flet ((bar () t))
                (cons #'bar (lambda () (declare (dynamic-extent #'bar))))))
           'sb-ext:compiler-note)))
+
+(with-test (:name :bug-586105 :fails-on '(not (and :stack-allocatable-vectors
+                                                   :stack-allocatable-lists)))
+  (flet ((test (x)
+           (let ((vec (make-array 1 :initial-contents (list (list x)))))
+             (declare (dynamic-extent vec))
+             (assert (eql x (car (aref vec 0)))))))
+    (assert-no-consing (test 42))))
 
+(defun bug-681092 ()
+  (declare (optimize speed))
+  (let ((c 0))
+    (flet ((bar () c))
+      (declare (dynamic-extent #'bar))
+      (do () ((list) (bar))
+        (setf c 10)
+        (return (bar))))))
+(with-test (:name :bug-681092)
+  (assert (= 10 (bug-681092))))