(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)))
(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
(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)))
\f
(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
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)
(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
(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))))
(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))))
\f
+(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))))