(defvar *a-cons* (cons nil nil))
-#+stack-allocatable-closures
-(with-test (:name (:no-consing :dx-closures))
+(with-test (:name (:no-consing :dx-closures) :skipped-on '(not :stack-allocatable-closures))
(assert-no-consing (dxclosure 42)))
-#+stack-allocatable-lists
-(with-test (:name (:no-consing :dx-lists))
+(with-test (:name (:no-consing :dx-lists) :skipped-on '(not :stack-allocatable-lists))
(assert-no-consing (dxlength 1 2 3))
(assert-no-consing (dxlength t t t t t t))
(assert-no-consing (dxlength))
(with-test (:name (:no-consing :dx-value-cell))
(assert-no-consing (dx-value-cell 13)))
-#+stack-allocatable-fixed-objects
-(with-test (:name (:no-consing :dx-fixed-objects))
+(with-test (:name (:no-consing :dx-fixed-objects) :skipped-on '(not :stack-allocatable-fixed-objects))
(assert-no-consing (cons-on-stack 42))
(assert-no-consing (make-foo1-on-stack 123))
(assert-no-consing (nested-good 42))
(assert-no-consing (dx-handler-bind 2))
(assert-no-consing (dx-handler-case 2)))
-#+stack-allocatable-vectors
-(with-test (:name (:no-consing :dx-vectors))
+(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-5))
(assert-no-consing (vector-on-stack :x :y)))
-#+raw-instance-init-vops
-(with-test (:name (:no-consing :dx-raw-instances) :fails-on :ppc)
+(with-test (:name (:no-consing :dx-raw-instances) :fails-on :ppc :skipped-on '(not :raw-instance-init-vops))
(let (a b)
(setf a 1.24 b 1.23d0)
(assert-no-consing (make-foo2-on-stack a b)))
(sb-thread:with-mutex (*mutex*)
(true *mutex*)))
-#+sb-thread
-(with-test (:name (:no-consing :mutex) :fails-on :ppc)
+(with-test (:name (:no-consing :mutex) :fails-on :ppc :skipped-on '(not :sb-thread))
(assert-no-consing (test-mutex)))
-#+sb-thread
-(with-test (:name (:no-consing :spinlock) :fails-on :ppc)
+(with-test (:name (:no-consing :spinlock) :fails-on :ppc :skipped-on '(not :sb-thread))
(assert-no-consing (test-spinlock)))
\f
(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))))))))