robustify COUNT-FULL-CALLS in the test suite
[sbcl.git] / tests / compiler.impure.lisp
index 4361794..a6df1ea 100644 (file)
 (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)
                              (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