robustify COUNT-FULL-CALLS in the test suite

 Move it to compiler-test-utils.lisp, while at it.

diff --git a/tests/compiler-test-util.lisp b/tests/compiler-test-util.lisp
index f0745d2..352db70 100644 (file)
--- a/tests/compiler-test-util.lisp
+++ b/tests/compiler-test-util.lisp
@@ -17,6 +17,7 @@
   (:export #:assert-consing
            #:assert-no-consing
            #:compiler-derived-type
+           #:count-full-calls
            #:find-value-cell-values
            #:find-code-constants
            #:find-named-callees
@@ -110,3 +111,16 @@
              (values warn fail)))
       (ignore-errors (delete-file lisp))
       (ignore-errors (delete-file fasl)))))
+
+;; Pretty horrible, but does the job
+(defun count-full-calls (name function)
+  (let ((code (with-output-to-string (s)
+                (disassemble function :stream s)))
+        (n 0))
+    (with-input-from-string (s code)
+      (loop for line = (read-line s nil nil)
+            while line
+            when (and (search name line)
+                      (search "#<FDEFINITION" line))
+            do (incf n)))
+    n))

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 4361794..a6df1ea 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -961,38 +961,27 @@
 (defun foo-inline (x) (quux-marker x))
 (declaim (maybe-inline foo-maybe-inline))
 (defun foo-maybe-inline (x) (quux-marker x))
-;; Pretty horrible, but does the job
-(defun count-full-calls (name function)
-  (let ((code (with-output-to-string (s)
-                (disassemble function :stream s)))
-        (n 0))
-    (with-input-from-string (s code)
-      (loop for line = (read-line s nil nil)
-            while line
-            when (search name line)
-            do (incf n)))
-    n))
 
 (with-test (:name :nested-inline-calls)
   (let ((fun (compile nil `(lambda (x)
                              (foo-inline (foo-inline (foo-inline x)))))))
-    (assert (= 0 (count-full-calls "FOO-INLINE" fun)))
-    (assert (= 3 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-INLINE" fun)))
+    (assert (= 3 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :nested-maybe-inline-calls)
   (let ((fun (compile nil `(lambda (x)
                              (declare (optimize (space 0)))
                              (foo-maybe-inline (foo-maybe-inline (foo-maybe-inline x)))))))
-    (assert (= 0 (count-full-calls "FOO-MAYBE-INLINE" fun)))
-    (assert (= 1 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-MAYBE-INLINE" fun)))
+    (assert (= 1 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :inline-calls)
   (let ((fun (compile nil `(lambda (x)
                              (list (foo-inline x)
                                    (foo-inline x)
                                    (foo-inline x))))))
-    (assert (= 0 (count-full-calls "FOO-INLINE" fun)))
-    (assert (= 3 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-INLINE" fun)))
+    (assert (= 3 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :maybe-inline-calls)
   (let ((fun (compile nil `(lambda (x)
@@ -1000,8 +989,8 @@
                              (list (foo-maybe-inline x)
                                    (foo-maybe-inline x)
                                    (foo-maybe-inline x))))))
-    (assert (= 0 (count-full-calls "FOO-MAYBE-INLINE" fun)))
-    (assert (= 1 (count-full-calls "QUUX-MARKER" fun)))))
+    (assert (= 0 (ctu:count-full-calls "FOO-MAYBE-INLINE" fun)))
+    (assert (= 1 (ctu:count-full-calls "QUUX-MARKER" fun)))))
 
 (with-test (:name :bug-405)
   ;; These used to break with a TYPE-ERROR