[Sbcl-commits] CVS: sbcl/tests expect.sh,NONE,1.1 clos.test.sh,1.3,1.4 compiler.test.sh,1.4,1.5 threads.impure.lisp,1.2,1.3

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv16991/tests

Modified Files:
	clos.test.sh compiler.test.sh threads.impure.lisp 
Added Files:
	expect.sh 
Log Message:
0.8.2.52:
	Partial fix for method definition protocol
	... ANSI in its wisdom saith that the mere addition of a bogus
		method to a generic function is not cause for signalling
		an error.  Signal a warning instead, and defer the error
		to when the function is called.
	Factor out common testing code into a sourceable script, and
	adjust the clos tests to reflect this new interpretation


--- NEW FILE: expect.sh ---
# file to be sourced by scripts wanting to test the compiler

# 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.
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)
EOF
    if [ $? != 52 ]; then
	echo compile-and-load $1 test failed: $?
	exit 1
    fi

    # 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)
EOF
    if [ $? != 52 ]; then
	echo load-into-interpreter $1 test failed: $?
	exit 1
    fi
}

# 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 () 
{
    $SBCL <<EOF
        (multiple-value-bind (pathname warnings-p failure-p)
            (compile-file "$1")
          (declare (ignore pathname))
          (assert (not warnings-p))
          (assert (not failure-p))
          (sb-ext:quit :unix-status 52))
EOF
    if [ $? != 52 ]; then
        echo clean-compile $1 test failed: $?
        exit 1
    fi
}

expect_warned_compile ()
{
    $SBCL <<EOF
        (multiple-value-bind (pathname warnings-p failure-p)
            (compile-file "$1")
          (declare (ignore pathname))
          (assert warnings-p)
          (assert (not failure-p))
          (sb-ext:quit :unix-status 52))
EOF
    if [ $? != 52 ]; then
        echo warn-compile $1 test failed: $?
        exit 1
    fi
}

expect_failed_compile ()
{
    $SBCL <<EOF
        (multiple-value-bind (pathname warnings-p failure-p)
            (compile-file "$1")
          (declare (ignore pathname warnings-p))
          (assert failure-p)
          (sb-ext:quit :unix-status 52))
EOF
    if [ $? != 52 ]; then
        echo fail-compile $1 test failed: $?
        exit 1
    fi
}

fail_on_compiler_note ()
{
    $SBCL <<EOF
        (handler-bind ((sb-ext:compiler-note #'error))
          (compile-file "$1")
          (sb-ext:quit :unix-status 52))
EOF
    if [ $? != 52]; then
        echo compiler-note $1 test failed: $?
        exit 1
    fi
}


Index: clos.test.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.test.sh,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- clos.test.sh	14 Aug 2002 13:26:00 -0000	1.3
+++ clos.test.sh	21 Aug 2003 11:38:42 -0000	1.4
@@ -11,61 +11,7 @@
 # absolutely no warranty. See the COPYING and CREDITS files for
 # more information.
 
-# 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.
-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)
-EOF
-    if [ $? != 52 ]; then
-	echo compile-and-load $1 test failed: $?
-	exit 1
-    fi
-
-    # 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)
-EOF
-    if [ $? != 52 ]; then
-	echo load-into-interpreter $1 test failed: $?
-	exit 1
-    fi
-}
-
-# 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 () 
-{
-    $SBCL <<EOF
-        (multiple-value-bind (pathname warnings-p failure-p)
-            (compile-file "$1")
-          (declare (ignore pathname))
-          (assert (not warnings-p))
-          (assert (not failure-p))
-          (sb-ext:quit :unix-status 52))
-EOF
-    if [ $? != 52 ]; then
-        echo clean-compile $1 test failed: $?
-        exit 1
-    fi
-}
+. expect.sh
 
 base_tmpfilename="clos-test-$$-tmp"
 tmpfilename="$base_tmpfilename.lisp"
@@ -78,6 +24,7 @@
     ;; This definition has too many qualifiers, so loading the
     ;; DEFMETHOD should fail.
     (defmethod zut progn :around ((x integer)) (print "integer"))
+    (zut 1)
 EOF
 expect_load_error $tmpfilename
 
@@ -89,6 +36,7 @@
     ;; This definition is missing the PROGN qualifier, and so the
     ;; DEFMETHOD should fail.
     (defmethod zut ((x integer)) (print "integer"))
+    (zut 1)
 EOF
 expect_load_error $tmpfilename
 
@@ -103,6 +51,7 @@
     ;; This definition has too many qualifiers, so loading the
     ;; DEFMETHOD should fail.
     (defmethod zut progn :around ((x integer)) (print "integer"))
+    (zut 1)
 EOF
 expect_load_error $tmpfilename
 

Index: compiler.test.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.test.sh,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- compiler.test.sh	18 Aug 2003 16:46:29 -0000	1.4
+++ compiler.test.sh	21 Aug 2003 11:38:42 -0000	1.5
@@ -11,104 +11,7 @@
 # absolutely no warranty. See the COPYING and CREDITS files for
 # more information.
 
-# FIXME: the functions below should be in their own file, sourced by
-# each of the *.test.sh scripts.
-
-# 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.
-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)
-EOF
-    if [ $? != 52 ]; then
-	echo compile-and-load $1 test failed: $?
-	exit 1
-    fi
-
-    # 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)
-EOF
-    if [ $? != 52 ]; then
-	echo load-into-interpreter $1 test failed: $?
-	exit 1
-    fi
-}
-
-# Test that a file compiles cleanly, with no ERRORs, WARNINGs or
-# STYLE-WARNINGs.
-expect_clean_compile () 
-{
-    $SBCL <<EOF
-        (multiple-value-bind (pathname warnings-p failure-p)
-            (compile-file "$1")
-          (declare (ignore pathname))
-          (assert (not warnings-p))
-          (assert (not failure-p))
-          (sb-ext:quit :unix-status 52))
-EOF
-    if [ $? != 52 ]; then
-        echo clean-compile $1 test failed: $?
-        exit 1
-    fi
-}
-
-expect_warned_compile ()
-{
-    $SBCL <<EOF
-        (multiple-value-bind (pathname warnings-p failure-p)
-            (compile-file "$1")
-          (declare (ignore pathname))
-          (assert warnings-p)
-          (assert (not failure-p))
-          (sb-ext:quit :unix-status 52))
-EOF
-    if [ $? != 52 ]; then
-        echo warn-compile $1 test failed: $?
-        exit 1
-    fi
-}
-
-expect_failed_compile ()
-{
-    $SBCL <<EOF
-        (multiple-value-bind (pathname warnings-p failure-p)
-            (compile-file "$1")
-          (declare (ignore pathname warnings-p))
-          (assert failure-p)
-          (sb-ext:quit :unix-status 52))
-EOF
-    if [ $? != 52 ]; then
-        echo fail-compile $1 test failed: $?
-        exit 1
-    fi
-}
-
-fail_on_compiler_note ()
-{
-    $SBCL <<EOF
-        (handler-bind ((sb-ext:compiler-note #'error))
-          (compile-file "$1")
-          (sb-ext:quit :unix-status 52))
-EOF
-    if [ $? != 52]; then
-        echo compiler-note $1 test failed: $?
-        exit 1
-    fi
-}
+. expect.sh
 
 base_tmpfilename="compiler-test-$$-tmp"
 tmpfilename="$base_tmpfilename.lisp"

Index: threads.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/threads.impure.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- threads.impure.lisp	16 Aug 2003 20:38:40 -0000	1.2
+++ threads.impure.lisp	21 Aug 2003 11:38:42 -0000	1.3
@@ -125,4 +125,7 @@
     (sleep 5))
   (terminate-thread child))
 
+;; better would be "wait until all child threads have exited"
+(sleep 3)
+
 (sb-ext:quit :unix-status 104)