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