5 |
|
|
6 |
(in-package :cl-test) |
(in-package :cl-test) |
7 |
|
|
8 |
(defun compile-file-test (file funname &rest args &key expect-warnings output-file |
(defun compile-file-test (file funname &rest args &key expect-warnings |
9 |
|
expect-style-warnings output-file |
10 |
print verbose external-format) |
print verbose external-format) |
11 |
(declare (ignorable verbose external-format)) |
(declare (ignorable verbose external-format)) |
12 |
(let* ((target-pathname (or output-file |
(let* ((target-pathname (or output-file |
28 |
((or error warning) |
((or error warning) |
29 |
#'(lambda (c) |
#'(lambda (c) |
30 |
(declare (ignore c)) |
(declare (ignore c)) |
31 |
(setf actual-warnings-p t) |
(unless (typep c 'style-warning) |
32 |
|
(setf actual-warnings-p t)) |
33 |
nil))) |
nil))) |
34 |
(with-output-to-string |
(with-output-to-string |
35 |
(*standard-output* str) |
(*standard-output* str) |
42 |
(destructuring-bind |
(destructuring-bind |
43 |
(output-truename warnings-p failure-p) |
(output-truename warnings-p failure-p) |
44 |
vals |
vals |
|
(declare (ignore warnings-p)) |
|
45 |
(assert (if actual-warnings-p failure-p t)) |
(assert (if actual-warnings-p failure-p t)) |
46 |
(assert (if expect-warnings failure-p t)) |
(assert (if expect-warnings failure-p t)) |
47 |
|
(assert (if expect-style-warnings warnings-p t)) |
48 |
(print (namestring (truename target-pathname))) |
(print (namestring (truename target-pathname))) |
49 |
(print (namestring output-truename)) |
(print (namestring output-truename)) |
50 |
(values |
(values |
62 |
|
|
63 |
(deftest compile-file.2 |
(deftest compile-file.2 |
64 |
(compile-file-test "compile-file-test-file-2.lsp" 'compile-file-test-fun.2 |
(compile-file-test "compile-file-test-file-2.lsp" 'compile-file-test-fun.2 |
65 |
:expect-warnings t) |
:expect-style-warnings t) |
66 |
t t nil nil) |
t t nil nil) |
67 |
|
|
68 |
(deftest compile-file.3 |
(deftest compile-file.3 |