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 despite the apparent type mismatch, because of
  54 # the NOTINLINE declamation.
  55 cat > $tmpfilename <<EOF
  56     (in-package :cl-user)
  57     (defun foo (x) (list x))
  58     (declaim (notinline foo))
  59     (defun bar (x) (1+ (foo x)))
  60 EOF
  61 expect_clean_compile $tmpfilename
  62
  63 # This shouldn't fail despite the apparent type mismatch, because of
  64 # the NOTINLINE declaration.
  65 cat > $tmpfilename <<EOF
  66     (in-package :cl-user)
  67     (defun foo (x) (list x))
  68     (defun bar (x)
  69       (declare (notinline foo))
  70       (1+ (foo x)))
  71 EOF
  72 expect_clean_compile $tmpfilename
  73
  74 # This in an ideal world would fail (that is, return with FAILURE-P
  75 # set), but at present it doesn't.
  76 cat > $tmpfilename <<EOF
  77     (in-package :cl-user)
  78     (defun foo (x) (list x))
  79     (defun bar (x)
  80       (declare (notinline foo))
  81       (locally
  82         (declare (inline foo))
  83         (1+ (foo x))))
  84 EOF
  85 # expect_failed_compile $tmpfilename
  86
  87 # This used to not warn, because the VALUES derive-type optimizer was
  88 # insufficiently precise.
  89 cat > $tmpfilename <<EOF
  90     (in-package :cl-user)
  91     (defun foo (x) (declare (ignore x)) (values))
  92     (defun bar (x) (1+ (foo x)))
  93 EOF
  94 expect_failed_compile $tmpfilename
  95
  96 # Even after making the VALUES derive-type optimizer more precise, the
  97 # following should still be clean.
  98 cat > $tmpfilename <<EOF
  99     (in-package :cl-user)
 100     (defun foo (x) (declare (ignore x)) (values))
 101     (defun bar (x) (car x))
 102 EOF
 103 expect_clean_compile $tmpfilename
 104
 105 # NOTINLINE on known functions shouldn't inhibit type inference
 106 # (spotted by APD sbcl-devel 2003-06-14)
 107 cat > $tmpfilename <<EOF
 108     (in-package :cl-user)
 109     (defun foo (x)
 110       (declare (notinline list))
 111       (1+ (list x)))
 112 EOF
 113 expect_failed_compile $tmpfilename
 114
 115 # ERROR wants to check its format string for sanity...
 116 cat > $tmpfilename <<EOF
 117     (in-package :cl-user)
 118     (defun foo (x)
 119       (when x
 120         (error "~S")))
 121 EOF
 122 expect_failed_compile $tmpfilename
 123
 124 # ... but it (ERROR) shouldn't complain about being unable to optimize
 125 # when it's uncertain about its argument's type
 126 cat > $tmpfilename <<EOF
 127     (in-package :cl-user)
 128     (defun foo (x)
 129       (error x))
 130 EOF
 131 fail_on_compiler_note $tmpfilename
 132
 133 # test case from Rudi for some CLOS WARNINGness that shouldn't have
 134 # been there
 135 cat > $tmpfilename <<EOF
 136     (eval-when (:compile-toplevel :load-toplevel :execute)
 137       (defstruct buffer-state
 138         (output-index 0)))
 139
 140     (defclass buffered-stream-mixin ()
 141       ((buffer-state :initform (make-buffer-state))))
 142
 143     (defgeneric frob (stream))
 144     (defmethod frob ((stream t))
 145       nil)
 146     (defmethod frob ((stream buffered-stream-mixin))
 147       (symbol-macrolet
 148             ((index (buffer-state-output-index (slot-value stream 'buffer-state))))
 149           (setf index 0))
 150       (call-next-method))
 151 EOF
 152 expect_clean_compile $tmpfilename
 153
 154 # undeclared unbound variables should cause a full warning, as they
 155 # invoke undefined behaviour
 156 cat > $tmpfilename <<EOF
 157     (defun foo () x)
 158 EOF
 159 expect_failed_compile $tmpfilename
 160
 161 cat > $tmpfilename <<EOF
 162     (declaim (special *x*))
 163     (defun foo () *x*)
 164 EOF
 165 expect_clean_compile $tmpfilename
 166
 167 cat > $tmpfilename <<EOF
 168     (defun foo () (declare (special x)) x)
 169 EOF
 170 expect_clean_compile $tmpfilename
 171
 172 # MUFFLE-CONDITIONS tests
 173 cat > $tmpfilename <<EOF
 174     (defun foo ()
 175       (declare (muffle-conditions style-warning))
 176       (bar))
 177 EOF
 178 expect_clean_compile $tmpfilename
 179
 180 cat > $tmpfilename <<EOF
 181     (defun foo ()
 182       (declare (muffle-conditions code-deletion-note))
 183       (if t (foo) (foo)))
 184 EOF
 185 fail_on_compiler_note $tmpfilename
 186
 187 cat > $tmpfilename <<EOF
 188     (defun foo (x y)
 189       (declare (muffle-conditions compiler-note))
 190       (declare (optimize speed))
 191       (+ x y))
 192 EOF
 193 fail_on_compiler_note $tmpfilename
 194
 195 cat > $tmpfilename <<EOF
 196     (declaim (muffle-conditions compiler-note))
 197     (defun foo (x y)
 198       (declare (optimize speed))
 199       (+ x y))
 200 EOF
 201 fail_on_compiler_note $tmpfilename
 202
 203 cat > $tmpfilename <<EOF
 204     (declaim (muffle-conditions compiler-note))
 205     (defun foo (x y)
 206       (declare (unmuffle-conditions compiler-note))
 207       (declare (optimize speed))
 208       (+ x y))
 209 EOF
 210 expect_compiler_note $tmpfilename
 211
 212 # undefined variable causes a WARNING
 213 cat > $tmpfilename <<EOF
 214     (declaim (muffle-conditions warning))
 215     (declaim (unmuffle-conditions style-warning))
 216     (defun foo () x)
 217 EOF
 218 expect_clean_compile $tmpfilename
 219
 220 # top level LOCALLY behaves nicely
 221 cat > $tmpfilename <<EOF
 222     (locally
 223       (declare (muffle-conditions warning))
 224       (defun foo () x))
 225 EOF
 226 expect_clean_compile $tmpfilename
 227
 228 cat > $tmpfilename <<EOF
 229     (locally
 230       (declare (muffle-conditions warning))
 231       (defun foo () x))
 232     (defun bar () x)
 233 EOF
 234 expect_failed_compile $tmpfilename
 235
 236 rm $tmpfilename
 237 rm $compiled_tmpfilename
 238
 239 # success
 240 exit 104