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

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

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

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