X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler-test-util.lisp;h=66685b9eccaa83a24b48811ed925b07c51747738;hb=11b5ac86a98f058fe0375b0a707c6ef9e24590c9;hp=1ed4fa6d6af3e2eac531c8320f949fcdb456fc7e;hpb=485944b1d04b8f3381a04bc6291bc2e667442e45;p=sbcl.git

diff --git a/tests/compiler-test-util.lisp b/tests/compiler-test-util.lisp
index 1ed4fa6..66685b9 100644
--- a/tests/compiler-test-util.lisp
+++ b/tests/compiler-test-util.lisp
@@ -14,7 +14,9 @@
 (defpackage :compiler-test-util
   (:nicknames :ctu)
   (:use :cl :sb-c :sb-kernel)
-  (:export #:compiler-derived-type
+  (:export #:assert-consing
+           #:assert-no-consing
+           #:compiler-derived-type
            #:find-value-cell-values
            #:find-named-callees))
 
@@ -46,3 +48,23 @@
                            (or (not namep)
                                (equal name (sb-impl::fdefn-name c))))))
           collect (sb-impl::fdefn-fun c))))
+
+(defmacro assert-no-consing (form &optional times)
+  `(%assert-no-consing (lambda () ,form) ,times))
+(defun %assert-no-consing (thunk &optional times)
+  (let ((before (sb-ext:get-bytes-consed))
+        (times (or times 10000)))
+    (declare (type (integer 1 *) times))
+    (dotimes (i times)
+      (funcall thunk))
+    (assert (< (- (sb-ext:get-bytes-consed) before) times))))
+
+(defmacro assert-consing (form &optional times)
+  `(%assert-consing (lambda () ,form) ,times))
+(defun %assert-consing (thunk &optional times)
+  (let ((before (sb-ext:get-bytes-consed))
+        (times (or times 10000)))
+    (declare (type (integer 1 *) times))
+    (dotimes (i times)
+      (funcall thunk))
+    (assert (not (< (- (sb-ext:get-bytes-consed) before) times)))))