1.0.12: release, will be tagged as sbcl_1_0_12

[sbcl.git] / tests / dynamic-extent.impure.lisp

diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 4ec3d4d..d22342d 100644 (file)
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -160,6 +160,35 @@
     (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 ()
+  (let ((dx (if (true t)
+                (list 1 2 3)
+                (list 2 3 4))))
+    (declare (dynamic-extent dx))
+    (true dx)
+    nil))
+
 ;;; with-spinlock should use DX and not cons
 
 (defvar *slock* (sb-thread::make-spinlock :name "slocklock"))
@@ -186,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))
@@ -201,6 +242,9 @@
   (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))
   #+sb-thread