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 # This should fail, and fail nicely -- not eg. loop trying to dump
 265 # references to the unbound variable.
 266 cat > $tmpfilename <<EOF
 267 (defmacro macro-with-unbound-variables (foo)
 268   \`(print ,bar))
 269
 270 (macro-with-unbound-variables 'xxx)
 271 EOF
 272 expect_failed_compile $tmpfilename
 273
 274 # This should fail, as the MAKE-LOAD-FORM must be used for
 275 # externalizing conditions, and the method for CONDITION must signal
 276 # an error.
 277 cat > $tmpfilename <<EOF
 278 (defvar *oops* #.(make-condition 'condition))
 279 EOF
 280 expect_failed_compile $tmpfilename
 281
 282 # This should fail, as the MAKE-LOAD-FORM must be used for objects,
 283 # and the method for STANDARD.OBJECT is required to signal an error.
 284 cat > $tmpfilename <<EOF
 285 (defvar *oops* #.(make-instance 'standard-object))
 286 EOF
 287 expect_failed_compile $tmpfilename
 288
 289 # This should be clean
 290 cat > $tmpfilename <<EOF
 291 (defvar *string* (make-string 10 :element-type 'base-char))
 292 EOF
 293 expect_clean_compile $tmpfilename
 294
 295 # This should style-warn (but not warn or otherwise fail) as the call
 296 # to FORMAT has too many arguments, which is bad style but not
 297 # otherwise fatal.
 298 cat > $tmpfilename <<EOF
 299 (defun foo (a b)
 300   (format nil "abc~~def" a b))
 301 EOF
 302 expect_warned_compile $tmpfilename
 303
 304 # Tests that destructive-functions on known-constant data cause
 305 # compile-time warnings.
 306 cat > $tmpfilename <<EOF
 307 (let ((string "foo"))
 308   (defun foo ()
 309     (setf string "bar")))
 310 EOF
 311 expect_clean_compile $tmpfilename
 312
 313 cat > $tmpfilename <<EOF
 314 (defun foo ()
 315   (let (result)
 316     (nreverse result)))
 317 EOF
 318 expect_clean_compile $tmpfilename
 319
 320 cat > $tmpfilename <<EOF
 321 (defun bar ()
 322   (let ((result ""))
 323     (nreverse result)))
 324 EOF
 325 expect_clean_compile $tmpfilename
 326
 327 cat > $tmpfilename <<EOF
 328 (let ((string "foo"))
 329   (defun foo ()
 330     (replace string "bar")))
 331 EOF
 332 expect_failed_compile $tmpfilename
 333
 334 cat > $tmpfilename <<EOF
 335 (defun foo ()
 336   (setf (char "bar" 0) #\1))
 337 EOF
 338 expect_failed_compile $tmpfilename
 339
 340 cat > $tmpfilename <<EOF
 341 (let ((foo '(1 2 3)))
 342   (defun foo ()
 343     (nconc foo foo)))
 344 EOF
 345 expect_failed_compile $tmpfilename
 346
 347 cat > $tmpfilename <<EOF
 348 (declaim (optimize (speed 3) (space 0) (safety 0)))
 349
 350 (defun foo (bar)
 351   (last bar))
 352 EOF
 353 expect_clean_compile $tmpfilename
 354
 355 rm $tmpfilename
 356 rm $compiled_tmpfilename
 357
 358 # success
 359 exit 104