From 7150425c976b17ba531a468966f6496fe2313a79 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 11 Apr 2005 12:46:35 +0000 Subject: [PATCH] Fix up error condition tests for compile-file --- ansi-tests/compile-file.lsp | 54 +++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/ansi-tests/compile-file.lsp b/ansi-tests/compile-file.lsp index 7150dbb7..9ce7cdae 100644 --- a/ansi-tests/compile-file.lsp +++ b/ansi-tests/compile-file.lsp @@ -24,10 +24,11 @@ (declare (ignore c)) (setf actual-style-warnings-p t) nil)) - (warning #'(lambda (c) - (declare (ignore c)) - (setf actual-warnings-p t) - nil))) + ((or error warning) + #'(lambda (c) + (declare (ignore c)) + (setf actual-warnings-p t) + nil))) (with-output-to-string (*standard-output* str) (apply #'compile-file file :allow-other-keys t args)))))) @@ -39,13 +40,14 @@ (destructuring-bind (output-truename warnings-p failure-p) vals + (declare (ignore warnings-p)) + (assert (if actual-warnings-p failure-p t)) + (assert (if expect-warnings failure-p t)) + (print (namestring (truename target-pathname))) + (print (namestring output-truename)) (values (equalpt (namestring (truename target-pathname)) (namestring output-truename)) - (if expect-warnings (list ; (notnot warnings-p) - actual-style-warnings-p) - (if warnings-p actual-style-warnings-p - (not actual-style-warnings-p))) (notnot failure-p) (notnot (fboundp funname)) (progn @@ -54,66 +56,72 @@ (deftest compile-file.1 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1) - t t nil nil nil) + t nil nil nil) (deftest compile-file.2 - (compile-file-test "compile-file-test-file-2.lsp" 'compile-file-test-fun.2 :expect-warnings t) - t (t) nil nil nil) + (compile-file-test "compile-file-test-file-2.lsp" 'compile-file-test-fun.2 + :expect-warnings t) + t t nil nil) (deftest compile-file.3 (let ((*package* (find-package "CL-TEST"))) (compile-file-test "compile-file-test-file-3.lsp" 'compile-file-test-fun.3)) - t t nil nil nil) + t nil nil nil) (deftest compile-file.4 (let ((*package* (find-package "CL-USER"))) (compile-file-test "compile-file-test-file-3.lsp" 'cl-user::compile-file-test-fun.3)) - t t nil nil nil) + t nil nil nil) (deftest compile-file.5 (compile-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1) - t t nil nil nil) + t nil nil nil) (deftest compile-file.6 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :output-file "foo.fasl") - t t nil nil nil) + t nil nil nil) + +(deftest compile-file.6a + (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 + :output-file "foo.ufsl") + t nil nil nil) (deftest compile-file.7 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :external-format :default) - t t nil nil nil) + t nil nil nil) (deftest compile-file.8 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :output-file #p"foo.fasl") - t t nil nil nil) + t nil nil nil) (deftest compile-file.9 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :print t) - t t nil nil nil) + t nil nil nil) (deftest compile-file.10 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :verbose t) - t t nil nil nil) + t nil nil nil) (deftest compile-file.11 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :print nil) - t t nil nil nil) + t nil nil nil) (deftest compile-file.12 (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :verbose nil) - t t nil nil nil) + t nil nil nil) ;;; A file stream is a pathname designator (deftest compile-file.13 (with-open-file (s "compile-file-test-file.lsp" :direction :input) (compile-file-test s 'compile-file-test-fun.1)) - t t nil nil nil) + t nil nil nil) (deftest compile-file.14 (let ((s (open "foo.fasl" :direction :output :if-exists :supersede @@ -121,7 +129,7 @@ (close s) (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :output-file s)) - t t nil nil nil) + t nil nil nil) ;;; Add tests for *compile-file-truename*, *compile-file-pathname* -- GitLab