X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fexpect.sh;h=383b5f87af51a18fe9805d7b33ec35b48bb940b9;hb=6c1e23b7535e86697e518125f60550ecac82439d;hp=9a209faa1f84818e3de0e049837534ba181d0535;hpb=5b43e28a5a9f0fcdefc2132840492e2e382876c6;p=sbcl.git

diff --git a/tests/expect.sh b/tests/expect.sh
index 9a209fa..383b5f8 100644
--- a/tests/expect.sh
+++ b/tests/expect.sh
@@ -1,102 +1,143 @@
 # file to be sourced by scripts wanting to test the compiler
 
+. ./subr.sh
+
 # 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.
-    $SBCL <<EOF
-	(compile-file "$1")
-	;;; 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 52)
+    f="$1"
+    run_sbcl <<EOF
+        (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:exit :code $EXIT_LISP_WIN)
 EOF
-    if [ $? != 52 ]; then
-	echo compile-and-load $1 test failed: $?
-	exit 1
-    fi
+    check_status_maybe_lose compile-and-load $?
 
     # Test loading into the interpreter.
-    $SBCL <<EOF
-	(multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
-	    (assert (null value0))
-	    (format t "VALUE1=~S (~A)~%" value1 value1)
-	    (assert (typep value1 'error)))
-	(sb-ext:quit :unix-status 52)
+    f="$1"
+    run_sbcl <<EOF
+        (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: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 "$f")))
+          (assert value0)
+          (assert (null value1)))
+        (sb-ext:exit :code $EXIT_LISP_WIN)
 EOF
-    if [ $? != 52 ]; then
-	echo load-into-interpreter $1 test failed: $?
-	exit 1
-    fi
+    check_status_maybe_lose load-compiled $?
 }
 
 # Test that a file compiles cleanly, with no ERRORs, WARNINGs or
 # STYLE-WARNINGs.
-#
-# Maybe this wants to be in a compiler.test.sh script?  This function
-# was originally written to test APD's patch for slot readers and
-# writers not being known to the compiler. -- CSR, 2002-08-14
-expect_clean_compile () 
+expect_clean_compile ()
 {
-    $SBCL <<EOF
+    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 52))
+          (sb-ext:exit :code $EXIT_LISP_WIN))
 EOF
-    if [ $? != 52 ]; then
-        echo clean-compile $1 test failed: $?
-        exit 1
-    fi
+    check_status_maybe_lose clean-compile $?
 }
 
 expect_warned_compile ()
 {
-    $SBCL <<EOF
+    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 52))
+          (sb-ext:exit :code $EXIT_LISP_WIN))
 EOF
-    if [ $? != 52 ]; then
-        echo warn-compile $1 test failed: $?
-        exit 1
-    fi
+    check_status_maybe_lose warn-compile $?
 }
 
 expect_failed_compile ()
 {
-    $SBCL <<EOF
+    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 52))
+          (sb-ext:exit :code $EXIT_LISP_WIN))
+EOF
+    check_status_maybe_lose fail-compile $?
+}
+
+expect_aborted_compile ()
+{
+    f="$1"
+    run_sbcl <<EOF
+        (let* ((lisp "$f")
+               (fasl (compile-file-pathname lisp)))
+          (multiple-value-bind (pathname warnings-p failure-p)
+              (compile-file "$f" :print t)
+            (assert (not pathname))
+            (assert failure-p)
+            (assert warnings-p)
+            (assert (not (probe-file fasl))))
+          (sb-ext:exit :code $EXIT_LISP_WIN))
+EOF
+    check_status_maybe_lose abort-compile $?
+}
+
+fail_on_condition_during_compile ()
+{
+    c="$1"
+    f="$2"
+    run_sbcl <<EOF
+        (handler-bind (($c #'error))
+          (compile-file "$f")
+          (sb-ext:exit :code $EXIT_LISP_WIN))
 EOF
-    if [ $? != 52 ]; then
-        echo fail-compile $1 test failed: $?
-        exit 1
-    fi
+    check_status_maybe_lose "fail-on-condition_$1" $?
 }
 
-fail_on_compiler_note ()
+expect_condition_during_compile ()
 {
-    $SBCL <<EOF
-        (handler-bind ((sb-ext:compiler-note #'error))
-          (compile-file "$1")
-          (sb-ext:quit :unix-status 52))
+    c="$1"
+    f="$2"
+    run_sbcl <<EOF
+        (handler-bind (($c (lambda (c)
+                             (declare (ignore c))
+                             (sb-ext:exit :code $EXIT_LISP_WIN))))
+          (compile-file "$f"))
 EOF
-    if [ $? != 52]; then
-        echo compiler-note $1 test failed: $?
-        exit 1
-    fi
+    check_status_maybe_lose "expect-condition_$1" $?
 }