X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.test.sh;h=73ed7052710b6c4fa5b1f0395cd63e6f92084980;hb=669eaea6857ab6211bfd6c00c7d227f3263200b9;hp=407088e4e65494ad65caac71207445ff1ba33da8;hpb=f2aa2d01b8d69f1c7bff18f86279d4f1018fe127;p=sbcl.git

diff --git a/tests/clos.test.sh b/tests/clos.test.sh
index 407088e..73ed705 100644
--- a/tests/clos.test.sh
+++ b/tests/clos.test.sh
@@ -11,41 +11,11 @@
 # 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
-}
+. ./expect.sh
 
-tmpfilename="clos-test-$$-tmp.lisp"
+base_tmpfilename="clos-test-$$-tmp"
+tmpfilename="$base_tmpfilename.lisp"
+compiled_tmpfilename="$base_tmpfilename.fasl"
 
 # This should fail, but didn't until sbcl-0.6.12.7, with Martin
 # Atzmueller's port of Pierre Mai's fixes.
@@ -54,6 +24,7 @@ cat > $tmpfilename <<EOF
     ;; 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
 
@@ -65,6 +36,7 @@ cat > $tmpfilename <<EOF
     ;; 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
 
@@ -79,10 +51,26 @@ cat > $tmpfilename <<EOF
     ;; 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
 
+# Until sbcl-0.7.6.21, PCL signalled spurious STYLE-WARNINGs on
+# compilation of this form; the report (bug #191a.) and a patch
+# suppressing these were provided by Alexey Dejenka in quick
+# succession.
+cat > $tmpfilename <<EOF
+    (in-package :cl-user)
+    (defclass another-class-with-slots () 
+      (a-new-slot-name))
+    (defun foo (x)
+      (values (setf (slot-value x 'a-new-slot-name) 2)
+              (slot-value x 'a-new-slot-name)))
+EOF
+expect_clean_compile $tmpfilename
+
 rm $tmpfilename
+rm $compiled_tmpfilename
 
 # success 
 exit 104