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