source: trunk/tests/ansi-tests/compile-file.lsp @ 9050

Last change on this file since 9050 was 9050, checked in by gz, 11 years ago

Muffle a couple more cases of random output

File size: 6.7 KB
RevLine 
[8991]1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr  9 08:25:25 2005
4;;;; Contains: Tests of COMPILE-FILE
5
6(in-package :cl-test)
7
8(defun compile-file-test (file funname &rest args &key
9                               expect-warnings
10                               expect-style-warnings output-file
11                               (print nil print-p)
12                               (verbose nil verbose-p)
13                               (*compile-print* nil)
14                               (*compile-verbose* nil)
15                               external-format)
16  (declare (ignorable external-format))
17  (let* ((target-pathname (or output-file
18                              (compile-file-pathname file)))
19         (actual-warnings-p nil)
20         (actual-style-warnings-p nil))
21    (when (probe-file target-pathname)
22      (delete-file target-pathname))
23    (fmakunbound funname)
24    (let* ((str (make-array '(0) :element-type 'character :adjustable t :fill-pointer 0))
25           (vals (multiple-value-list
26                  (handler-bind
27                   ((style-warning #'(lambda (c)
28                                       (declare (ignore c))
29                                       (setf actual-style-warnings-p t)
30                                       nil))
31                    ((or error warning)
32                     #'(lambda (c)
33                         (unless (typep c 'style-warning)
34                           (setf actual-warnings-p t))
[9050]35                         (when (and (typep c 'warning) (not *test-verbose*))
36                           (muffle-warning c))
[8991]37                         nil)))
38                   (with-output-to-string
39                     (*standard-output* str)
40                     (apply #'compile-file file :allow-other-keys t args))))))
41      (assert (= (length vals) 3))
42      (destructuring-bind
43          (output-truename warnings-p failure-p)
44          vals
[9045]45        (when *test-verbose*
46          (print (namestring (truename target-pathname)))
47          (print (namestring output-truename)))
[8991]48        (values
49         (let ((v1 (or print verbose
50                       (and (not print-p) *compile-print*)
51                       (and (not verbose-p) *compile-verbose*)
52                       (string= str "")))
53               (v2 (or (and verbose-p (not verbose))
54                       (and (not verbose-p) (not *compile-verbose*))
55                       (position #\; str)))
56               (v3 (if actual-warnings-p failure-p t))
57               (v4 (if expect-warnings failure-p t))
58               (v5 (if expect-style-warnings warnings-p t))
59               (v6 (or (null output-truename) (pathnamep output-truename)))
60               (v7 (equalpt-or-report (namestring (truename target-pathname))
61                                      (namestring output-truename)))
62               (v8 (not (fboundp funname))))
63           (if (and v1 v2 v3 v4 v5 v6 (eql v7 t) v8) t
64             (list v1 v2 v3 v4 v5 v6 v7 v8)))
65         (progn
66           (load output-truename)
67           (funcall funname)))))))
68
69(deftest compile-file.1
70  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1)
71  t nil)
72
73(deftest compile-file.2
74  (compile-file-test "compile-file-test-file-2.lsp" 'compile-file-test-fun.2
75                     :expect-style-warnings t)
76  t nil)
77
78(deftest compile-file.2a
79  (compile-file-test "compile-file-test-file-2a.lsp" 'compile-file-test-fun.2a
80                     :expect-warnings t)
81  t nil)
82
83(deftest compile-file.3
84  (let ((*package* (find-package "CL-TEST")))
85    (compile-file-test "compile-file-test-file-3.lsp" 'compile-file-test-fun.3))
86  t nil)
87
88(deftest compile-file.4
89  (let ((*package* (find-package "CL-USER")))
90    (compile-file-test "compile-file-test-file-3.lsp" 'cl-user::compile-file-test-fun.3))
91  t nil)
92
93(deftest compile-file.5
94  (compile-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1)
95  t nil)
96
97(deftest compile-file.6
98  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
99                     :output-file "foo.fasl")
100  t nil)
101
102(deftest compile-file.6a
103  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
104                     :output-file "foo.ufsl")
105  t nil)
106
107(deftest compile-file.7
108  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
109                     :external-format :default)
110  t nil)
111
112(deftest compile-file.8
113  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
114                     :output-file #p"foo.fasl")
115  t nil)
116
117(deftest compile-file.9
118  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
119                     :print t)
120  t nil)
121
122(deftest compile-file.10
123  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
124                     :verbose t)
125  t nil)
126
127(deftest compile-file.11
128  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
129                     :print nil)
130  t nil)
131
132(deftest compile-file.12
133  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
134                     :verbose nil)
135  t nil)
136
137;;; A file stream is a pathname designator
138(deftest compile-file.13
139  (with-open-file (s "compile-file-test-file.lsp" :direction :input)
140                  (compile-file-test s 'compile-file-test-fun.1))
141  t nil)
142
143(deftest compile-file.14
144  (let ((s (open "foo.fasl" :direction :output :if-exists :supersede
145                 :if-does-not-exist :create)))
146    (close s)
147    (compile-file-test "compile-file-test-file.lsp"
148                       'compile-file-test-fun.1
149                       :output-file s))
150  t nil)
151
152(deftest compile-file.15
153  (let ((*readtable* (copy-readtable nil)))
154    (set-macro-character #\! (get-macro-character #\'))
155    (compile-file-test "compile-file-test-file-4.lsp" 'compile-file-test-fun.4))
156  t foo)
157
158;;; Tests for *compile-file-truename*, *compile-file-pathname*
159
160(deftest compile-file.16
161  (let* ((file #p"compile-file-test-file-5.lsp")
162         (target-pathname (compile-file-pathname file))
163         (*compile-print* nil)
164         (*compile-verbose* nil))
165    (when (probe-file target-pathname)
166      (delete-file target-pathname))
167    (compile-file file)
168    (load target-pathname)
169    (values
170     (equalpt-or-report (truename file) (funcall 'compile-file-test-fun.5))
171     (equalpt-or-report (pathname (merge-pathnames file))
172                        (funcall 'compile-file-test-fun.5a))))
173  t t)
174
175;;; Add tests of logical pathnames
176
177(deftest compile-file.17
178  (let ((file (logical-pathname "CLTEST:COMPILE-FILE-TEST-LP.LSP")))
179    (with-open-file
180     (s file :direction :output :if-exists :supersede :if-does-not-exist :create)
181     (format s "(in-package :cl-test)~%(defun compile-file-test-lp.fun () nil)~%"))
182    (compile-file-test file 'compile-file-test-lp.fun))
183  t nil)
184
185(deftest compile-file.18
186  (let ((file (logical-pathname "CLTEST:COMPILE-FILE-TEST-LP.OUT")))
187    (with-open-file
188     (s file :direction :output :if-exists :supersede :if-does-not-exist :create))
189    (compile-file-test "compile-file-test-file.lsp"
190                       'compile-file-test-fun.1
191                       :output-file file))
192  t nil)
193
194(deftest compile-file.19
195  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
196                     :*compile-verbose* t)
197  t nil)
198
199(deftest compile-file.20
200  (compile-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1
201                     :*compile-print* t)
202  t nil) 
203
204(deftest compile-file-pathname.1
205  *compile-file-pathname*
206  nil)
207
208(deftest compile-file-truename.1
209  *compile-file-truename*
210  nil)
211
212;;; Error cases
213
214(deftest compile-file.error.1
215  (signals-error (compile-file "nonexistent-file-to-compile.lsp") file-error)
216  t)
217
218(deftest compile-file.error.2
219  (signals-error (compile-file) program-error)
220  t)
221
222
223
224
Note: See TracBrowser for help on using the repository browser.