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 base_tmpfilename="compiler-test-$$-tmp"
 101 tmpfilename="$base_tmpfilename.lisp"
 102 compiled_tmpfilename="$base_tmpfilename.fasl"
 103
 104 # This should fail, as type inference should show that the call to FOO
 105 # will return something of the wrong type.
 106 cat > $tmpfilename <<EOF
 107     (in-package :cl-user)
 108     (defun foo (x) (list x))
 109     (defun bar (x) (1+ (foo x)))
 110 EOF
 111 expect_failed_compile $tmpfilename
 112
 113 # This should fail, as we define a function multiply in the same file
 114 # (CLHS 3.2.2.3).
 115 cat > $tmpfilename <<EOF
 116     (in-package :cl-user)
 117     (defun foo (x) (list x))
 118     (defun foo (x) (cons x x))
 119 EOF
 120 expect_failed_compile $tmpfilename
 121
 122 # This shouldn't fail, as the inner FLETs should not be treated as
 123 # having the same name.
 124 cat > $tmpfilename <<EOF
 125     (in-package :cl-user)
 126     (defun foo (x)
 127       (flet ((baz (y) (load y)))
 128         (declare (notinline baz))
 129         (baz x)))
 130     (defun bar (x)
 131       (flet ((baz (y) (load y)))
 132         (declare (notinline baz))
 133         (baz x)))
 134 EOF
 135 expect_clean_compile $tmpfilename
 136
 137 # This shouldn't fail despite the apparent type mismatch, because of
 138 # the NOTINLINE declamation.
 139 cat > $tmpfilename <<EOF
 140     (in-package :cl-user)
 141     (defun foo (x) (list x))
 142     (declaim (notinline foo))
 143     (defun bar (x) (1+ (foo x)))
 144 EOF
 145 expect_clean_compile $tmpfilename
 146
 147 # This shouldn't fail despite the apparent type mismatch, because of
 148 # the NOTINLINE declaration.
 149 cat > $tmpfilename <<EOF
 150     (in-package :cl-user)
 151     (defun foo (x) (list x))
 152     (defun bar (x)
 153       (declare (notinline foo))
 154       (1+ (foo x)))
 155 EOF
 156 expect_clean_compile $tmpfilename
 157
 158 # This in an ideal world would fail (that is, return with FAILURE-P
 159 # set), but at present it doesn't.
 160 cat > $tmpfilename <<EOF
 161     (in-package :cl-user)
 162     (defun foo (x) (list x))
 163     (defun bar (x)
 164       (declare (notinline foo))
 165       (locally
 166         (declare (inline foo))
 167         (1+ (foo x))))
 168 EOF
 169 # expect_failed_compile $tmpfilename
 170
 171 # This used to not warn, because the VALUES derive-type optimizer was
 172 # insufficiently precise.
 173 cat > $tmpfilename <<EOF
 174     (in-package :cl-user)
 175     (defun foo (x) (declare (ignore x)) (values))
 176     (defun bar (x) (1+ (foo x)))
 177 EOF
 178 expect_failed_compile $tmpfilename
 179
 180 # Even after making the VALUES derive-type optimizer more precise, the
 181 # following should still be clean.
 182 cat > $tmpfilename <<EOF
 183     (in-package :cl-user)
 184     (defun foo (x) (declare (ignore x)) (values))
 185     (defun bar (x) (car x))
 186 EOF
 187 expect_clean_compile $tmpfilename
 188
 189 # NOTINLINE on known functions shouldn't inhibit type inference
 190 # (spotted by APD sbcl-devel 2003-06-14)
 191 cat > $tmpfilename <<EOF
 192     (in-package :cl-user)
 193     (defun foo (x)
 194       (declare (notinline list))
 195       (1+ (list x)))
 196 EOF
 197 expect_failed_compile $tmpfilename
 198
 199 rm $tmpfilename
 200 rm $compiled_tmpfilename
 201
 202 # success
 203 exit 104