0.8.0.59:
[sbcl.git] / 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 rm $tmpfilename
190 rm $compiled_tmpfilename
191
192 # success 
193 exit 104