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 # FIXME: the functions below should be in their own file, sourced by
  15 # each of the *.test.sh scripts.
  16
  17 # Check that compiling and loading the file $1 generates an error
  18 # at load time; also that just loading it directly (into the
  19 # interpreter) generates an error.
  20 expect_load_error ()
  21 {
  22     # Test compiling and loading.
  23     $SBCL <<EOF
  24         (compile-file "$1")
  25         ;;; But loading the file should fail.
  26         (multiple-value-bind (value0 value1) (ignore-errors (load *))
  27             (assert (null value0))
  28             (format t "VALUE1=~S (~A)~%" value1 value1)
  29             (assert (typep value1 'error)))
  30         (sb-ext:quit :unix-status 52)
  31 EOF
  32     if [ $? != 52 ]; then
  33         echo compile-and-load $1 test failed: $?
  34         exit 1
  35     fi
  36
  37     # Test loading into the interpreter.
  38     $SBCL <<EOF
  39         (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
  40             (assert (null value0))
  41             (format t "VALUE1=~S (~A)~%" value1 value1)
  42             (assert (typep value1 'error)))
  43         (sb-ext:quit :unix-status 52)
  44 EOF
  45     if [ $? != 52 ]; then
  46         echo load-into-interpreter $1 test failed: $?
  47         exit 1
  48     fi
  49 }
  50
  51 # Test that a file compiles cleanly, with no ERRORs, WARNINGs or
  52 # STYLE-WARNINGs.
  53 expect_clean_compile ()
  54 {
  55     $SBCL <<EOF
  56         (multiple-value-bind (pathname warnings-p failure-p)
  57             (compile-file "$1")
  58           (declare (ignore pathname))
  59           (assert (not warnings-p))
  60           (assert (not failure-p))
  61           (sb-ext:quit :unix-status 52))
  62 EOF
  63     if [ $? != 52 ]; then
  64         echo clean-compile $1 test failed: $?
  65         exit 1
  66     fi
  67 }
  68
  69 expect_warned_compile ()
  70 {
  71     $SBCL <<EOF
  72         (multiple-value-bind (pathname warnings-p failure-p)
  73             (compile-file "$1")
  74           (declare (ignore pathname))
  75           (assert warnings-p)
  76           (assert (not failure-p))
  77           (sb-ext:quit :unix-status 52))
  78 EOF
  79     if [ $? != 52 ]; then
  80         echo warn-compile $1 test failed: $?
  81         exit 1
  82     fi
  83 }
  84
  85 expect_failed_compile ()
  86 {
  87     $SBCL <<EOF
  88         (multiple-value-bind (pathname warnings-p failure-p)
  89             (compile-file "$1")
  90           (declare (ignore pathname warnings-p))
  91           (assert failure-p)
  92           (sb-ext:quit :unix-status 52))
  93 EOF
  94     if [ $? != 52 ]; then
  95         echo fail-compile $1 test failed: $?
  96         exit 1
  97     fi
  98 }
  99
 100 fail_on_compiler_note ()
 101 {
 102     $SBCL <<EOF
 103         (handler-bind ((sb-ext:compiler-note #'error))
 104           (compile-file "$1")
 105           (sb-ext:quit :unix-status 52))
 106 EOF
 107     if [ $? != 52]; then
 108         echo compiler-note $1 test failed: $?
 109         exit 1
 110     fi
 111 }
 112
 113 base_tmpfilename="compiler-test-$$-tmp"
 114 tmpfilename="$base_tmpfilename.lisp"
 115 compiled_tmpfilename="$base_tmpfilename.fasl"
 116
 117 # This should fail, as type inference should show that the call to FOO
 118 # will return something of the wrong type.
 119 cat > $tmpfilename <<EOF
 120     (in-package :cl-user)
 121     (defun foo (x) (list x))
 122     (defun bar (x) (1+ (foo x)))
 123 EOF
 124 expect_failed_compile $tmpfilename
 125
 126 # This should fail, as we define a function multiply in the same file
 127 # (CLHS 3.2.2.3).
 128 cat > $tmpfilename <<EOF
 129     (in-package :cl-user)
 130     (defun foo (x) (list x))
 131     (defun foo (x) (cons x x))
 132 EOF
 133 expect_failed_compile $tmpfilename
 134
 135 # This shouldn't fail, as the inner FLETs should not be treated as
 136 # having the same name.
 137 cat > $tmpfilename <<EOF
 138     (in-package :cl-user)
 139     (defun foo (x)
 140       (flet ((baz (y) (load y)))
 141         (declare (notinline baz))
 142         (baz x)))
 143     (defun bar (x)
 144       (flet ((baz (y) (load y)))
 145         (declare (notinline baz))
 146         (baz x)))
 147 EOF
 148 expect_clean_compile $tmpfilename
 149
 150 # This shouldn't fail despite the apparent type mismatch, because of
 151 # the NOTINLINE declamation.
 152 cat > $tmpfilename <<EOF
 153     (in-package :cl-user)
 154     (defun foo (x) (list x))
 155     (declaim (notinline foo))
 156     (defun bar (x) (1+ (foo x)))
 157 EOF
 158 expect_clean_compile $tmpfilename
 159
 160 # This shouldn't fail despite the apparent type mismatch, because of
 161 # the NOTINLINE declaration.
 162 cat > $tmpfilename <<EOF
 163     (in-package :cl-user)
 164     (defun foo (x) (list x))
 165     (defun bar (x)
 166       (declare (notinline foo))
 167       (1+ (foo x)))
 168 EOF
 169 expect_clean_compile $tmpfilename
 170
 171 # This in an ideal world would fail (that is, return with FAILURE-P
 172 # set), but at present it doesn't.
 173 cat > $tmpfilename <<EOF
 174     (in-package :cl-user)
 175     (defun foo (x) (list x))
 176     (defun bar (x)
 177       (declare (notinline foo))
 178       (locally
 179         (declare (inline foo))
 180         (1+ (foo x))))
 181 EOF
 182 # expect_failed_compile $tmpfilename
 183
 184 # This used to not warn, because the VALUES derive-type optimizer was
 185 # insufficiently precise.
 186 cat > $tmpfilename <<EOF
 187     (in-package :cl-user)
 188     (defun foo (x) (declare (ignore x)) (values))
 189     (defun bar (x) (1+ (foo x)))
 190 EOF
 191 expect_failed_compile $tmpfilename
 192
 193 # Even after making the VALUES derive-type optimizer more precise, the
 194 # following should still be clean.
 195 cat > $tmpfilename <<EOF
 196     (in-package :cl-user)
 197     (defun foo (x) (declare (ignore x)) (values))
 198     (defun bar (x) (car x))
 199 EOF
 200 expect_clean_compile $tmpfilename
 201
 202 # NOTINLINE on known functions shouldn't inhibit type inference
 203 # (spotted by APD sbcl-devel 2003-06-14)
 204 cat > $tmpfilename <<EOF
 205     (in-package :cl-user)
 206     (defun foo (x)
 207       (declare (notinline list))
 208       (1+ (list x)))
 209 EOF
 210 expect_failed_compile $tmpfilename
 211
 212 # ERROR wants to check its format string for sanity...
 213 cat > $tmpfilename <<EOF
 214     (in-package :cl-user)
 215     (defun foo (x)
 216       (when x
 217         (error "~S")))
 218 EOF
 219 expect_failed_compile $tmpfilename
 220
 221 # ... but it (ERROR) shouldn't complain about being unable to optimize
 222 # when it's uncertain about its argument's type
 223 cat > $tmpfilename <<EOF
 224     (in-package :cl-user)
 225     (defun foo (x)
 226       (error x))
 227 EOF
 228 fail_on_compiler_note $tmpfilename
 229
 230 rm $tmpfilename
 231 rm $compiled_tmpfilename
 232
 233 # success
 234 exit 104