# Check that compiling and loading the file $1 generates an error
# at load time; also that just loading it directly (into the
# interpreter) generates an error.
+
+# In bash,
+#
+# function callee() { cat }
+# function caller() { callee bar <<EOF \n $1 \n EOF \n }
+# caller foo
+#
+# will print "foo". In certain versions of sh, however, it will print
+# "bar" instead. Hence variables f and c in the following code.
+
expect_load_error ()
{
# Test compiling and loading.
+ f="$1"
run_sbcl <<EOF
- (compile-file "$1")
+ (compile-file "$f")
;;; But loading the file should fail.
(multiple-value-bind (value0 value1) (ignore-errors (load *))
(assert (null value0))
(format t "VALUE1=~S (~A)~%" value1 value1)
(assert (typep value1 'error)))
- (sb-ext:quit :unix-status $EXIT_LISP_WIN)
+ (sb-ext:exit :code $EXIT_LISP_WIN)
EOF
check_status_maybe_lose compile-and-load $?
# Test loading into the interpreter.
+ f="$1"
run_sbcl <<EOF
- (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
+ (multiple-value-bind (value0 value1) (ignore-errors (load "$f"))
(assert (null value0))
(format t "VALUE1=~S (~A)~%" value1 value1)
(assert (typep value1 'error)))
- (sb-ext:quit :unix-status $EXIT_LISP_WIN)
+ (sb-ext:exit :code $EXIT_LISP_WIN)
EOF
check_status_maybe_lose load-into-interpreter $?
}
expect_clean_cload ()
{
expect_clean_compile $1
+ f="$1"
run_sbcl <<EOF
(multiple-value-bind (value0 value1)
- (ignore-errors (load (compile-file-pathname "$1")))
+ (ignore-errors (load (compile-file-pathname "$f")))
(assert value0)
(assert (null value1)))
- (sb-ext:quit :unix-status $EXIT_LISP_WIN)
+ (sb-ext:exit :code $EXIT_LISP_WIN)
EOF
check_status_maybe_lose load-compiled $?
}
# STYLE-WARNINGs.
expect_clean_compile ()
{
+ f="$1"
run_sbcl <<EOF
(multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
+ (compile-file "$f")
(declare (ignore pathname))
(assert (not warnings-p))
(assert (not failure-p))
- (sb-ext:quit :unix-status $EXIT_LISP_WIN))
+ (sb-ext:exit :code $EXIT_LISP_WIN))
EOF
check_status_maybe_lose clean-compile $?
}
expect_warned_compile ()
{
+ f="$1"
run_sbcl <<EOF
(multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
+ (compile-file "$f")
(declare (ignore pathname))
(assert warnings-p)
(assert (not failure-p))
- (sb-ext:quit :unix-status $EXIT_LISP_WIN))
+ (sb-ext:exit :code $EXIT_LISP_WIN))
EOF
check_status_maybe_lose warn-compile $?
}
expect_failed_compile ()
{
+ f="$1"
run_sbcl <<EOF
(multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
+ (compile-file "$f")
(declare (ignore pathname warnings-p))
(assert failure-p)
- (sb-ext:quit :unix-status $EXIT_LISP_WIN))
+ (sb-ext:exit :code $EXIT_LISP_WIN))
EOF
check_status_maybe_lose fail-compile $?
}
expect_aborted_compile ()
{
+ f="$1"
run_sbcl <<EOF
- (let* ((lisp "$1")
+ (let* ((lisp "$f")
(fasl (compile-file-pathname lisp)))
(multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1" :print t)
+ (compile-file "$f" :print t)
(assert (not pathname))
(assert failure-p)
(assert warnings-p)
(assert (not (probe-file fasl))))
- (sb-ext:quit :unix-status $EXIT_LISP_WIN))
+ (sb-ext:exit :code $EXIT_LISP_WIN))
EOF
check_status_maybe_lose abort-compile $?
}
-fail_on_compiler_note ()
+fail_on_condition_during_compile ()
{
+ c="$1"
+ f="$2"
run_sbcl <<EOF
- (handler-bind ((sb-ext:compiler-note #'error))
- (compile-file "$1")
- (sb-ext:quit :unix-status $EXIT_LISP_WIN))
+ (handler-bind (($c #'error))
+ (compile-file "$f")
+ (sb-ext:exit :code $EXIT_LISP_WIN))
EOF
- check_status_maybe_lose fail-on-compiler-note $?
+ check_status_maybe_lose "fail-on-condition_$1" $?
}
-expect_compiler_note ()
+expect_condition_during_compile ()
{
+ c="$1"
+ f="$2"
run_sbcl <<EOF
- (handler-bind ((sb-ext:compiler-note (lambda (c)
- (declare (ignore c))
- (sb-ext:quit :unix-status
- $EXIT_LISP_WIN))))
- (compile-file "$1"))
+ (handler-bind (($c (lambda (c)
+ (declare (ignore c))
+ (sb-ext:exit :code $EXIT_LISP_WIN))))
+ (compile-file "$f"))
EOF
- check_status_maybe_lose expect-compiler-note $?
+ check_status_maybe_lose "expect-condition_$1" $?
}
+