X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler-test-util.lisp;h=a21f04fefb192a7e2aafa456bc06e444deab065c;hb=eca61f35572d371982ebb601d0edefe5c9a942ae;hp=f05e3fae7cc6882e9786a9a93b621c8542186c2e;hpb=157ce74bc2e47d56017cfd998e16f033447851ca;p=sbcl.git diff --git a/tests/compiler-test-util.lisp b/tests/compiler-test-util.lisp index f05e3fa..a21f04f 100644 --- a/tests/compiler-test-util.lisp +++ b/tests/compiler-test-util.lisp @@ -19,7 +19,8 @@ #:compiler-derived-type #:find-value-cell-values #:find-code-constants - #:find-named-callees)) + #:find-named-callees + #:file-compile)) (cl:in-package :ctu) @@ -92,3 +93,18 @@ (defmacro assert-consing (form &optional (times '+times+)) `(check-consing t ',form (lambda () ,form) ,times)) + +(defun file-compile (toplevel-forms &key load) + (let* ((lisp "compile-impure-tmp.lisp") + (fasl (compile-file-pathname lisp))) + (unwind-protect + (progn + (with-open-file (f lisp :direction :output) + (dolist (form toplevel-forms) + (prin1 form f))) + (multiple-value-bind (fasl warn fail) (compile-file lisp) + (when load + (load fasl)) + (values warn fail))) + (ignore-errors (delete-file lisp)) + (ignore-errors (delete-file fasl)))))