From: Christophe R. <cr...@us...> - 2004-05-17 16:18:11
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29187/tests Modified Files: compiler.impure.lisp compiler.test.sh expect.sh Log Message: 0.8.10.29: SB-EXT:MUFFLE-CONDITIONS. Go wild. ... rejig the implementation a bit more from the latest CSR sbcl-devel patch: new SB-C::*HANDLED-CONDITIONS* variable analogous to SB-C::*POLICY* (and treated with the same kinds of hack, too, with rebindings and other fakery to get the right semantics); ... more test cases; ... documentation; ... since we're in the general area, make SB-CLTL2:DECLARATION-INFORMATION work on it... ... and write test cases for this and OPTIMIZE. Index: compiler.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v retrieving revision 1.52 retrieving revision 1.53 diff -u -d -r1.52 -r1.53 --- compiler.impure.lisp 7 Jan 2004 09:10:33 -0000 1.52 +++ compiler.impure.lisp 17 May 2004 16:17:58 -0000 1.53 @@ -890,7 +890,24 @@ (type-error (c) (return-from return :good)))) :good)) - + +;;;; MUFFLE-CONDITIONS test (corresponds to the test in the manual) +(defvar *compiler-note-count* 0) +(handler-bind ((sb-ext:compiler-note (lambda (c) + (declare (ignore c)) + (incf *compiler-note-count*)))) + (let ((fun + (compile nil + '(lambda (x) + (declare (optimize speed) (fixnum x)) + (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) + (values (* x 5) ; no compiler note from this + (locally + (declare (sb-ext:unmuffle-conditions sb-ext:compiler-note)) + ;; this one gives a compiler note + (* x -5))))))) + (assert (= *compiler-note-count* 1)) + (assert (equal (multiple-value-list (funcall fun 1)) '(5 -5))))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself Index: compiler.test.sh =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.test.sh,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- compiler.test.sh 9 Mar 2004 12:08:41 -0000 1.8 +++ compiler.test.sh 17 May 2004 16:17:58 -0000 1.9 @@ -169,6 +169,70 @@ EOF expect_clean_compile $tmpfilename +# MUFFLE-CONDITIONS tests +cat > $tmpfilename <<EOF + (defun foo () + (declare (muffle-conditions style-warning)) + (bar)) +EOF +expect_clean_compile $tmpfilename + +cat > $tmpfilename <<EOF + (defun foo () + (declare (muffle-conditions code-deletion-note)) + (if t (foo) (foo))) +EOF +fail_on_compiler_note $tmpfilename + +cat > $tmpfilename <<EOF + (defun foo (x y) + (declare (muffle-conditions compiler-note)) + (declare (optimize speed)) + (+ x y)) +EOF +fail_on_compiler_note $tmpfilename + +cat > $tmpfilename <<EOF + (declaim (muffle-conditions compiler-note)) + (defun foo (x y) + (declare (optimize speed)) + (+ x y)) +EOF +fail_on_compiler_note $tmpfilename + +cat > $tmpfilename <<EOF + (declaim (muffle-conditions compiler-note)) + (defun foo (x y) + (declare (unmuffle-conditions compiler-note)) + (declare (optimize speed)) + (+ x y)) +EOF +expect_compiler_note $tmpfilename + +# undefined variable causes a WARNING +cat > $tmpfilename <<EOF + (declaim (muffle-conditions warning)) + (declaim (unmuffle-conditions style-warning)) + (defun foo () x) +EOF +expect_clean_compile $tmpfilename + +# top level LOCALLY behaves nicely +cat > $tmpfilename <<EOF + (locally + (declare (muffle-conditions warning)) + (defun foo () x)) +EOF +expect_clean_compile $tmpfilename + +cat > $tmpfilename <<EOF + (locally + (declare (muffle-conditions warning)) + (defun foo () x)) + (defun bar () x) +EOF +expect_failed_compile $tmpfilename + rm $tmpfilename rm $compiled_tmpfilename Index: expect.sh =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/expect.sh,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- expect.sh 3 Sep 2003 08:41:54 -0000 1.2 +++ expect.sh 17 May 2004 16:17:58 -0000 1.3 @@ -36,10 +36,6 @@ # 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 @@ -95,8 +91,21 @@ (sb-ext:quit :unix-status 52)) EOF if [ $? != 52 ]; then - echo compiler-note $1 test failed: $? + echo fail-on-compiler-note $1 test failed: $? exit 1 fi } +expect_compiler_note () +{ + $SBCL <<EOF + (handler-bind ((sb-ext:compiler-note (lambda (c) + (declare (ignore c)) + (sb-ext:quit :unix-status 52)))) + (compile-file "$1")) +EOF + if [ $? != 52 ]; then + echo expect-compiler-note $1 test failed: $? + exit 1 + fi +} |