(defun-with-dx dxcaller (&rest rest)
(declare (dynamic-extent rest))
(callee rest))
-
(assert (= (dxcaller 1 2 3 4 5 6 7) 22))
+(defun-with-dx dxcaller-align-1 (x &rest rest)
+ (declare (dynamic-extent rest))
+ (+ x (callee rest)))
+(assert (= (dxcaller-align-1 17 1 2 3 4 5 6 7) 39))
+(assert (= (dxcaller-align-1 17 1 2 3 4 5 6 7 8) 40))
+
;;; %NIP-VALUES
(defun-with-dx test-nip-values ()
(flet ((bar (x &rest y)
(opaque-identity :bar)
z)))
\f
+;;; alignment
+(defvar *x*)
+(defun-with-dx test-alignment-dx-list (form)
+ (multiple-value-prog1 (eval form)
+ (let ((l (list 1 2 3 4)))
+ (declare (dynamic-extent l))
+ (setq *x* (copy-list l)))))
+(dotimes (n 64)
+ (let* ((res (loop for i below n collect i))
+ (form `(values ,@res)))
+ (assert (equal (multiple-value-list (test-alignment-dx-list form)) res))
+ (assert (equal *x* '(1 2 3 4)))))
+
+
+
+\f
(defmacro assert-no-consing (form &optional times)
`(%assert-no-consing (lambda () ,form ,times)))
(defun %assert-no-consing (thunk &optional times)
(funcall thunk))
(assert (< (- (get-bytes-consed) before) times))))
-#+(or x86 x86-64)
+#+(or x86 x86-64 alpha ppc)
(progn
(assert-no-consing (dxlength 1 2 3))
(assert-no-consing (dxlength t t t t t t))
(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 (test-lvar-subst 11)))
\f
;;; Bugs found by Paul F. Dietz