1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / expect.sh
1 # file to be sourced by scripts wanting to test the compiler
2
3 . ./subr.sh
4
5 # Check that compiling and loading the file $1 generates an error
6 # at load time; also that just loading it directly (into the
7 # interpreter) generates an error.
8 expect_load_error ()
9 {
10     # Test compiling and loading.
11     run_sbcl <<EOF
12         (compile-file "$1")
13         ;;; But loading the file should fail.
14         (multiple-value-bind (value0 value1) (ignore-errors (load *))
15             (assert (null value0))
16             (format t "VALUE1=~S (~A)~%" value1 value1)
17             (assert (typep value1 'error)))
18         (sb-ext:quit :unix-status $EXIT_LISP_WIN)
19 EOF
20     check_status_maybe_lose compile-and-load $?
21
22     # Test loading into the interpreter.
23     run_sbcl <<EOF
24         (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
25             (assert (null value0))
26             (format t "VALUE1=~S (~A)~%" value1 value1)
27             (assert (typep value1 'error)))
28         (sb-ext:quit :unix-status $EXIT_LISP_WIN)
29 EOF
30     check_status_maybe_lose load-into-interpreter $?
31 }
32
33 expect_clean_cload ()
34 {
35     expect_clean_compile $1
36     run_sbcl <<EOF
37         (multiple-value-bind (value0 value1) 
38             (ignore-errors (load (compile-file-pathname "$1")))
39           (assert value0)
40           (assert (null value1)))
41         (sb-ext:quit :unix-status $EXIT_LISP_WIN)
42 EOF
43     check_status_maybe_lose load-compiled $?
44 }
45
46 # Test that a file compiles cleanly, with no ERRORs, WARNINGs or
47 # STYLE-WARNINGs.
48 expect_clean_compile ()
49 {
50     run_sbcl <<EOF
51         (multiple-value-bind (pathname warnings-p failure-p)
52             (compile-file "$1")
53           (declare (ignore pathname))
54           (assert (not warnings-p))
55           (assert (not failure-p))
56           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
57 EOF
58     check_status_maybe_lose clean-compile $?
59 }
60
61 expect_warned_compile ()
62 {
63     run_sbcl <<EOF
64         (multiple-value-bind (pathname warnings-p failure-p)
65             (compile-file "$1")
66           (declare (ignore pathname))
67           (assert warnings-p)
68           (assert (not failure-p))
69           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
70 EOF
71     check_status_maybe_lose warn-compile $?
72 }
73
74 expect_failed_compile ()
75 {
76     run_sbcl <<EOF
77         (multiple-value-bind (pathname warnings-p failure-p)
78             (compile-file "$1")
79           (declare (ignore pathname warnings-p))
80           (assert failure-p)
81           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
82 EOF
83     check_status_maybe_lose fail-compile $?
84 }
85
86 expect_aborted_compile ()
87 {
88     run_sbcl <<EOF
89         (let* ((lisp "$1")
90                (fasl (compile-file-pathname lisp)))
91           (multiple-value-bind (pathname warnings-p failure-p)
92               (compile-file "$1" :print t)
93             (assert (not pathname))
94             (assert failure-p)
95             (assert warnings-p)
96             (assert (not (probe-file fasl))))
97           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
98 EOF
99     check_status_maybe_lose abort-compile $?
100 }
101
102 fail_on_compiler_note ()
103 {
104     run_sbcl <<EOF
105         (handler-bind ((sb-ext:compiler-note #'error))
106           (compile-file "$1")
107           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
108 EOF
109     check_status_maybe_lose fail-on-compiler-note $?
110 }
111
112 expect_compiler_note ()
113 {
114     run_sbcl <<EOF
115         (handler-bind ((sb-ext:compiler-note (lambda (c)
116                                                (declare (ignore c))
117                                                (sb-ext:quit :unix-status
118                                                             $EXIT_LISP_WIN))))
119           (compile-file "$1"))
120 EOF
121     check_status_maybe_lose expect-compiler-note $?
122 }