-(defmacro assert-no-consing (form &optional times)
- `(%assert-no-consing (lambda () ,form) ,times))
-(defun %assert-no-consing (thunk &optional times)
- (let ((before (get-bytes-consed))
- (times (or times 10000)))
- (declare (type (integer 1 *) times))
- (dotimes (i times)
- (funcall thunk))
- (assert (< (- (get-bytes-consed) before) times))))
-
-(defmacro assert-consing (form &optional times)
- `(%assert-consing (lambda () ,form) ,times))
-(defun %assert-consing (thunk &optional times)
- (let ((before (get-bytes-consed))
- (times (or times 10000)))
- (declare (type (integer 1 *) times))
- (dotimes (i times)
- (funcall thunk))
- (assert (not (< (- (get-bytes-consed) before) times)))))
-
-(defvar *a-cons* (cons nil nil))
-
-(progn
- #+stack-allocatable-closures
- (assert-no-consing (dxclosure 42))
- #+stack-allocatable-lists
- (progn
- (assert-no-consing (dxlength 1 2 3))
- (assert-no-consing (dxlength t t t t t t))
- (assert-no-consing (dxlength))
- (assert-no-consing (dxcaller 1 2 3 4 5 6 7))
- (assert-no-consing (test-nip-values))
- (assert-no-consing (test-let-var-subst1 17))
- (assert-no-consing (test-let-var-subst2 17))
- (assert-no-consing (test-lvar-subst 11))
- (assert-no-consing (nested-dx-lists))
- (assert-consing (nested-dx-not-used *a-cons*))
- (assert-no-consing (nested-evil-dx-used *a-cons*))
- (assert-no-consing (multiple-dx-uses)))
- (assert-no-consing (dx-value-cell 13))
- #+stack-allocatable-fixed-objects
- (progn
- (assert-no-consing (cons-on-stack 42))
- (assert-no-consing (make-foo1-on-stack 123))
- (assert-no-consing (nested-good 42))
- (assert-no-consing (nested-dx-conses))
- (assert-no-consing (dx-handler-bind 2))
- (assert-no-consing (dx-handler-case 2)))
- #+stack-allocatable-vectors
- (progn
- (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))
- (assert-no-consing (make-array-on-stack-5))
- (assert-no-consing (vector-on-stack :x :y)))
- (#+raw-instance-init-vops assert-no-consing
- #-raw-instance-init-vops progn
- (make-foo2-on-stack 1.24 1.23d0))
- (#+raw-instance-init-vops assert-no-consing
- #-raw-instance-init-vops progn
- (make-foo3-on-stack))
- ;; Not strictly DX..
- (assert-no-consing (test-hash-table))
- #+sb-thread
- (progn
- (assert-no-consing (test-spinlock))
- (assert-no-consing (test-mutex))))