0.8.12.15:
[sbcl.git] / tests / compiler.test.sh
1 #!/bin/sh
2
3 # This software is part of the SBCL system. See the README file for
4 # more information.
5 #
6 # While most of SBCL is derived from the CMU CL system, the test
7 # files (like this one) were written from scratch after the fork
8 # from CMU CL.
9
10 # This software is in the public domain and is provided with
11 # absolutely no warranty. See the COPYING and CREDITS files for
12 # more information.
13
14 . ./expect.sh
15
16 base_tmpfilename="compiler-test-$$-tmp"
17 tmpfilename="$base_tmpfilename.lisp"
18 compiled_tmpfilename="$base_tmpfilename.fasl"
19
20 # This should fail, as type inference should show that the call to FOO
21 # will return something of the wrong type.
22 cat > $tmpfilename <<EOF
23     (in-package :cl-user)
24     (defun foo (x) (list x))
25     (defun bar (x) (1+ (foo x)))
26 EOF
27 expect_failed_compile $tmpfilename
28
29 # This should fail, as we define a function multiply in the same file
30 # (CLHS 3.2.2.3).
31 cat > $tmpfilename <<EOF
32     (in-package :cl-user)
33     (defun foo (x) (list x))
34     (defun foo (x) (cons x x))
35 EOF
36 expect_failed_compile $tmpfilename
37
38 # This shouldn't fail, as the inner FLETs should not be treated as
39 # having the same name.
40 cat > $tmpfilename <<EOF
41     (in-package :cl-user)
42     (defun foo (x) 
43       (flet ((baz (y) (load y)))
44         (declare (notinline baz))
45         (baz x)))
46     (defun bar (x) 
47       (flet ((baz (y) (load y)))
48         (declare (notinline baz))
49         (baz x)))
50 EOF
51 expect_clean_compile $tmpfilename
52
53 # This shouldn't fail because it's not really a multiple definition
54 cat > $tmpfilename <<EOF
55     (in-package :cl-user)
56     (eval-when (:compile-toplevel :load-toplevel :execute)
57       (defun foo (x) x))
58 EOF
59 expect_clean_compile $tmpfilename
60
61 # Likewise
62 cat > $tmpfilename <<EOF
63     (in-package :cl-user)
64     (eval-when (:compile-toplevel)
65       (defun foo (x) x))
66     (defun foo (x) x)
67 EOF
68 expect_clean_compile $tmpfilename
69
70 # This shouldn't fail despite the apparent type mismatch, because of
71 # the NOTINLINE declamation.
72 cat > $tmpfilename <<EOF
73     (in-package :cl-user)
74     (defun foo (x) (list x))
75     (declaim (notinline foo))
76     (defun bar (x) (1+ (foo x)))
77 EOF
78 expect_clean_compile $tmpfilename
79
80 # This shouldn't fail, but did until sbcl-0.8.10.4x
81 cat > $tmpfilename <<EOF
82     (in-package :cl-user)
83     (declaim (inline foo))
84     (defun foo (x)
85       (1+ x))
86     (defun bar (y)
87       (list (foo y) (if (> y 1) (funcall (if (> y 0) #'foo #'identity) y))))
88 EOF
89 expect_clean_compile $tmpfilename
90
91 # This shouldn't fail despite the apparent type mismatch, because of
92 # the NOTINLINE declaration.
93 cat > $tmpfilename <<EOF
94     (in-package :cl-user)
95     (defun foo (x) (list x))
96     (defun bar (x) 
97       (declare (notinline foo))
98       (1+ (foo x)))
99 EOF
100 expect_clean_compile $tmpfilename
101
102 # This in an ideal world would fail (that is, return with FAILURE-P
103 # set), but at present it doesn't.
104 cat > $tmpfilename <<EOF
105     (in-package :cl-user)
106     (defun foo (x) (list x))
107     (defun bar (x)
108       (declare (notinline foo))
109       (locally
110         (declare (inline foo))
111         (1+ (foo x))))
112 EOF
113 # expect_failed_compile $tmpfilename
114
115 # This used to not warn, because the VALUES derive-type optimizer was
116 # insufficiently precise.
117 cat > $tmpfilename <<EOF
118     (in-package :cl-user)
119     (defun foo (x) (declare (ignore x)) (values))
120     (defun bar (x) (1+ (foo x)))
121 EOF
122 expect_failed_compile $tmpfilename
123
124 # Even after making the VALUES derive-type optimizer more precise, the
125 # following should still be clean.
126 cat > $tmpfilename <<EOF
127     (in-package :cl-user)
128     (defun foo (x) (declare (ignore x)) (values))
129     (defun bar (x) (car x))
130 EOF
131 expect_clean_compile $tmpfilename
132
133 # NOTINLINE on known functions shouldn't inhibit type inference
134 # (spotted by APD sbcl-devel 2003-06-14)
135 cat > $tmpfilename <<EOF
136     (in-package :cl-user)
137     (defun foo (x)
138       (declare (notinline list))
139       (1+ (list x)))
140 EOF
141 expect_failed_compile $tmpfilename
142
143 # ERROR wants to check its format string for sanity...
144 cat > $tmpfilename <<EOF
145     (in-package :cl-user)
146     (defun foo (x)
147       (when x
148         (error "~S")))
149 EOF
150 expect_failed_compile $tmpfilename
151
152 # ... but it (ERROR) shouldn't complain about being unable to optimize
153 # when it's uncertain about its argument's type
154 cat > $tmpfilename <<EOF
155     (in-package :cl-user)
156     (defun foo (x)
157       (error x))
158 EOF
159 fail_on_compiler_note $tmpfilename
160
161 # test case from Rudi for some CLOS WARNINGness that shouldn't have
162 # been there
163 cat > $tmpfilename <<EOF
164     (eval-when (:compile-toplevel :load-toplevel :execute)
165       (defstruct buffer-state 
166         (output-index 0)))
167     
168     (defclass buffered-stream-mixin ()
169       ((buffer-state :initform (make-buffer-state))))
170     
171     (defgeneric frob (stream))
172     (defmethod frob ((stream t))
173       nil)
174     (defmethod frob ((stream buffered-stream-mixin))
175       (symbol-macrolet
176             ((index (buffer-state-output-index (slot-value stream 'buffer-state))))
177           (setf index 0))
178       (call-next-method))
179 EOF
180 expect_clean_compile $tmpfilename
181
182 # undeclared unbound variables should cause a full warning, as they
183 # invoke undefined behaviour
184 cat > $tmpfilename <<EOF
185     (defun foo () x)
186 EOF
187 expect_failed_compile $tmpfilename
188
189 cat > $tmpfilename <<EOF
190     (declaim (special *x*))
191     (defun foo () *x*)
192 EOF
193 expect_clean_compile $tmpfilename
194
195 cat > $tmpfilename <<EOF
196     (defun foo () (declare (special x)) x)
197 EOF
198 expect_clean_compile $tmpfilename
199
200 # MUFFLE-CONDITIONS tests
201 cat > $tmpfilename <<EOF
202     (defun foo ()
203       (declare (muffle-conditions style-warning))
204       (bar))
205 EOF
206 expect_clean_compile $tmpfilename
207
208 cat > $tmpfilename <<EOF
209     (defun foo ()
210       (declare (muffle-conditions code-deletion-note))
211       (if t (foo) (foo)))
212 EOF
213 fail_on_compiler_note $tmpfilename
214
215 cat > $tmpfilename <<EOF
216     (defun foo (x y)
217       (declare (muffle-conditions compiler-note))
218       (declare (optimize speed))
219       (+ x y))
220 EOF
221 fail_on_compiler_note $tmpfilename
222
223 cat > $tmpfilename <<EOF
224     (declaim (muffle-conditions compiler-note))
225     (defun foo (x y)
226       (declare (optimize speed))
227       (+ x y))
228 EOF
229 fail_on_compiler_note $tmpfilename
230
231 cat > $tmpfilename <<EOF
232     (declaim (muffle-conditions compiler-note))
233     (defun foo (x y)
234       (declare (unmuffle-conditions compiler-note))
235       (declare (optimize speed))
236       (+ x y))
237 EOF
238 expect_compiler_note $tmpfilename
239
240 # undefined variable causes a WARNING
241 cat > $tmpfilename <<EOF
242     (declaim (muffle-conditions warning))
243     (declaim (unmuffle-conditions style-warning))
244     (defun foo () x)
245 EOF
246 expect_clean_compile $tmpfilename
247
248 # top level LOCALLY behaves nicely
249 cat > $tmpfilename <<EOF
250     (locally
251       (declare (muffle-conditions warning))
252       (defun foo () x))
253 EOF
254 expect_clean_compile $tmpfilename
255
256 cat > $tmpfilename <<EOF
257     (locally
258       (declare (muffle-conditions warning))
259       (defun foo () x))
260     (defun bar () x)
261 EOF
262 expect_failed_compile $tmpfilename
263
264 rm $tmpfilename
265 rm $compiled_tmpfilename
266
267 # success 
268 exit 104