X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fdynamic-extent.impure.lisp;h=d22342d512a09ac28e1f48465fdf66076948b234;hb=41ebbebc360fc5b85e39d78fdaaba7d2f7577b10;hp=78923f3717f33f669d983a2e6c291ca6769fac2f;hpb=975f1932acc3a8e90fb31d2b055bfbdde78ea927;p=sbcl.git

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 78923f3..d22342d 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -160,6 +160,25 @@
     (true dx)
     nil))
 
+(defun-with-dx nested-dx-not-used (x)
+  (declare (list x))
+  (let ((l (setf (car x) (list x x x))))
+    (declare (dynamic-extent l))
+    (true l)
+    (true (length l))
+    nil))
+
+(defun-with-dx nested-evil-dx-used (x)
+  (declare (list x))
+  (let ((l (list x x x)))
+    (declare (dynamic-extent l))
+    (unwind-protect
+         (progn
+           (setf (car x) l)
+           (true l))
+      (setf (car x) nil))
+    nil))
+
 ;;; multiple uses for dx lvar
 
 (defun-with-dx multiple-dx-uses ()
@@ -196,6 +215,18 @@
       (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))
+
 #+(or x86 x86-64 alpha ppc sparc mips)
 (progn
   (assert-no-consing (dxclosure 42))
@@ -211,6 +242,8 @@
   (assert-no-consing (cons-on-stack 42))
   (assert-no-consing (nested-dx-conses))
   (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))
   ;; Not strictly DX..
   (assert-no-consing (test-hash-table))