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

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

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