[04d819]: tests / compiler.test.sh Maximize Restore History

Download this file

compiler.test.sh    360 lines (312 with data), 9.1 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
#!/bin/sh
# This software is part of the SBCL system. See the README file for
# more information.
#
# While most of SBCL is derived from the CMU CL system, the test
# files (like this one) were written from scratch after the fork
# from CMU CL.
#
# This software is in the public domain and is provided with
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
. ./expect.sh
base_tmpfilename="compiler-test-$$-tmp"
tmpfilename="$base_tmpfilename.lisp"
compiled_tmpfilename="$base_tmpfilename.fasl"
# This should fail, as type inference should show that the call to FOO
# will return something of the wrong type.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (list x))
(defun bar (x) (1+ (foo x)))
EOF
expect_failed_compile $tmpfilename
# This should fail, as we define a function multiply in the same file
# (CLHS 3.2.2.3).
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (list x))
(defun foo (x) (cons x x))
EOF
expect_failed_compile $tmpfilename
# This shouldn't fail, as the inner FLETs should not be treated as
# having the same name.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x)
(flet ((baz (y) (load y)))
(declare (notinline baz))
(baz x)))
(defun bar (x)
(flet ((baz (y) (load y)))
(declare (notinline baz))
(baz x)))
EOF
expect_clean_compile $tmpfilename
# This shouldn't fail because it's not really a multiple definition
cat > $tmpfilename <<EOF
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun foo (x) x))
EOF
expect_clean_compile $tmpfilename
# Likewise
cat > $tmpfilename <<EOF
(in-package :cl-user)
(eval-when (:compile-toplevel)
(defun foo (x) x))
(defun foo (x) x)
EOF
expect_clean_compile $tmpfilename
# This shouldn't fail despite the apparent type mismatch, because of
# the NOTINLINE declamation.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (list x))
(declaim (notinline foo))
(defun bar (x) (1+ (foo x)))
EOF
expect_clean_compile $tmpfilename
# This shouldn't fail, but did until sbcl-0.8.10.4x
cat > $tmpfilename <<EOF
(in-package :cl-user)
(declaim (inline foo))
(defun foo (x)
(1+ x))
(defun bar (y)
(list (foo y) (if (> y 1) (funcall (if (> y 0) #'foo #'identity) y))))
EOF
expect_clean_compile $tmpfilename
# This shouldn't fail despite the apparent type mismatch, because of
# the NOTINLINE declaration.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (list x))
(defun bar (x)
(declare (notinline foo))
(1+ (foo x)))
EOF
expect_clean_compile $tmpfilename
# This in an ideal world would fail (that is, return with FAILURE-P
# set), but at present it doesn't.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (list x))
(defun bar (x)
(declare (notinline foo))
(locally
(declare (inline foo))
(1+ (foo x))))
EOF
# expect_failed_compile $tmpfilename
# This used to not warn, because the VALUES derive-type optimizer was
# insufficiently precise.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (declare (ignore x)) (values))
(defun bar (x) (1+ (foo x)))
EOF
expect_failed_compile $tmpfilename
# Even after making the VALUES derive-type optimizer more precise, the
# following should still be clean.
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x) (declare (ignore x)) (values))
(defun bar (x) (car x))
EOF
expect_clean_compile $tmpfilename
# NOTINLINE on known functions shouldn't inhibit type inference
# (spotted by APD sbcl-devel 2003-06-14)
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x)
(declare (notinline list))
(1+ (list x)))
EOF
expect_failed_compile $tmpfilename
# ERROR wants to check its format string for sanity...
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x)
(when x
(error "~S")))
EOF
expect_failed_compile $tmpfilename
# ... but it (ERROR) shouldn't complain about being unable to optimize
# when it's uncertain about its argument's type
cat > $tmpfilename <<EOF
(in-package :cl-user)
(defun foo (x)
(error x))
EOF
fail_on_compiler_note $tmpfilename
# test case from Rudi for some CLOS WARNINGness that shouldn't have
# been there
cat > $tmpfilename <<EOF
(eval-when (:compile-toplevel :load-toplevel :execute)
(defstruct buffer-state
(output-index 0)))
(defclass buffered-stream-mixin ()
((buffer-state :initform (make-buffer-state))))
(defgeneric frob (stream))
(defmethod frob ((stream t))
nil)
(defmethod frob ((stream buffered-stream-mixin))
(symbol-macrolet
((index (buffer-state-output-index (slot-value stream 'buffer-state))))
(setf index 0))
(call-next-method))
EOF
expect_clean_compile $tmpfilename
# undeclared unbound variables should cause a full warning, as they
# invoke undefined behaviour
cat > $tmpfilename <<EOF
(defun foo () x)
EOF
expect_failed_compile $tmpfilename
cat > $tmpfilename <<EOF
(declaim (special *x*))
(defun foo () *x*)
EOF
expect_clean_compile $tmpfilename
cat > $tmpfilename <<EOF
(defun foo () (declare (special x)) x)
EOF
expect_clean_compile $tmpfilename
# MUFFLE-CONDITIONS tests
cat > $tmpfilename <<EOF
(defun foo ()
(declare (muffle-conditions style-warning))
(bar))
EOF
expect_clean_compile $tmpfilename
cat > $tmpfilename <<EOF
(defun foo ()
(declare (muffle-conditions code-deletion-note))
(if t (foo) (foo)))
EOF
fail_on_compiler_note $tmpfilename
cat > $tmpfilename <<EOF
(defun foo (x y)
(declare (muffle-conditions compiler-note))
(declare (optimize speed))
(+ x y))
EOF
fail_on_compiler_note $tmpfilename
cat > $tmpfilename <<EOF
(declaim (muffle-conditions compiler-note))
(defun foo (x y)
(declare (optimize speed))
(+ x y))
EOF
fail_on_compiler_note $tmpfilename
cat > $tmpfilename <<EOF
(declaim (muffle-conditions compiler-note))
(defun foo (x y)
(declare (unmuffle-conditions compiler-note))
(declare (optimize speed))
(+ x y))
EOF
expect_compiler_note $tmpfilename
# undefined variable causes a WARNING
cat > $tmpfilename <<EOF
(declaim (muffle-conditions warning))
(declaim (unmuffle-conditions style-warning))
(defun foo () x)
EOF
expect_clean_compile $tmpfilename
# top level LOCALLY behaves nicely
cat > $tmpfilename <<EOF
(locally
(declare (muffle-conditions warning))
(defun foo () x))
EOF
expect_clean_compile $tmpfilename
cat > $tmpfilename <<EOF
(locally
(declare (muffle-conditions warning))
(defun foo () x))
(defun bar () x)
EOF
expect_failed_compile $tmpfilename
# This should fail, and fail nicely -- not eg. loop trying to dump
# references to the unbound variable.
cat > $tmpfilename <<EOF
(defmacro macro-with-unbound-variables (foo)
\`(print ,bar))
(macro-with-unbound-variables 'xxx)
EOF
expect_failed_compile $tmpfilename
# This should fail, as the MAKE-LOAD-FORM must be used for
# externalizing conditions, and the method for CONDITION must signal
# an error.
cat > $tmpfilename <<EOF
(defvar *oops* #.(make-condition 'condition))
EOF
expect_failed_compile $tmpfilename
# This should fail, as the MAKE-LOAD-FORM must be used for objects,
# and the method for STANDARD.OBJECT is required to signal an error.
cat > $tmpfilename <<EOF
(defvar *oops* #.(make-instance 'standard-object))
EOF
expect_failed_compile $tmpfilename
# This should be clean
cat > $tmpfilename <<EOF
(defvar *string* (make-string 10 :element-type 'base-char))
EOF
expect_clean_compile $tmpfilename
# This should style-warn (but not warn or otherwise fail) as the call
# to FORMAT has too many arguments, which is bad style but not
# otherwise fatal.
cat > $tmpfilename <<EOF
(defun foo (a b)
(format nil "abc~~def" a b))
EOF
expect_warned_compile $tmpfilename
# Tests that destructive-functions on known-constant data cause
# compile-time warnings.
cat > $tmpfilename <<EOF
(let ((string "foo"))
(defun foo ()
(setf string "bar")))
EOF
expect_clean_compile $tmpfilename
cat > $tmpfilename <<EOF
(defun foo ()
(let (result)
(nreverse result)))
EOF
expect_clean_compile $tmpfilename
cat > $tmpfilename <<EOF
(defun bar ()
(let ((result ""))
(nreverse result)))
EOF
expect_clean_compile $tmpfilename
cat > $tmpfilename <<EOF
(let ((string "foo"))
(defun foo ()
(replace string "bar")))
EOF
expect_failed_compile $tmpfilename
cat > $tmpfilename <<EOF
(defun foo ()
(setf (char "bar" 0) #\1))
EOF
expect_failed_compile $tmpfilename
cat > $tmpfilename <<EOF
(let ((foo '(1 2 3)))
(defun foo ()
(nconc foo foo)))
EOF
expect_failed_compile $tmpfilename
cat > $tmpfilename <<EOF
(declaim (optimize (speed 3) (space 0) (safety 0)))
(defun foo (bar)
(last bar))
EOF
expect_clean_compile $tmpfilename
rm $tmpfilename
rm $compiled_tmpfilename
# success
exit 104