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 rm $tmpfilename
 173 rm $compiled_tmpfilename
 174
 175 # success
 176 exit 104