[Sbcl-commits] CVS: sbcl/tests clos.impure.lisp, 1.98, 1.99 eval.impure.lisp, 1.17, 1.18

[<de...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5006/tests

Modified Files:
	clos.impure.lisp eval.impure.lisp 
Log Message:
1.0.21.6: muffle compiler notes from EVAL and function generator construction

 * Just add (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE)) to the lambdas
   we cons up: in case of EVAL the notes are distractive and seem
   pointless, and in case of generators the user is definitely not
   interested.

 * Adjust SB-CLTL2 tests slightly to account for possible pre-existing
   MUFFLE-CONDITIONS declarations, and fix usage of SPECIAL-BINDINGS.


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -d -r1.98 -r1.99
--- clos.impure.lisp	9 Jun 2008 21:49:16 -0000	1.98
+++ clos.impure.lisp	6 Oct 2008 09:14:27 -0000	1.99
@@ -1619,5 +1619,25 @@
 (handler-bind ((warning #'error))
   (assert (= 123 (slot-value (provoke-ctor-default-initarg-problem) 'slot))))
 
+;;;; discriminating net on streams used to generate code deletion notes on
+;;;; first call
+(defgeneric stream-fd (stream direction))
+(defmethod stream-fd ((stream sb-sys:fd-stream) direction)
+  (declare (ignore direction))
+  (sb-sys:fd-stream-fd stream))
+(defmethod stream-fd ((stream synonym-stream) direction)
+  (stream-fd (symbol-value (synonym-stream-symbol stream)) direction))
+(defmethod stream-fd ((stream two-way-stream) direction)
+  (ecase direction
+    (:input
+     (stream-fd
+      (two-way-stream-input-stream stream) direction))
+    (:output
+     (stream-fd
+      (two-way-stream-output-stream stream) direction))))
+(with-test (:name (:discriminating-name :code-deletion-note))
+  (handler-bind ((compiler-note #'error))
+    (stream-fd sb-sys:*stdin* :output)
+    (stream-fd sb-sys:*stdin* :output)))
 
 ;;;; success

Index: eval.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/eval.impure.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- eval.impure.lisp	2 May 2007 10:02:13 -0000	1.17
+++ eval.impure.lisp	6 Oct 2008 09:14:27 -0000	1.18
@@ -226,4 +226,15 @@
 (with-test (:name :toplevel-declare)
   (assert (raises-error? (eval '(declare (type pathname *scratch*))))))
 
+(with-test (:name (eval no-compiler-notes))
+  (handler-bind ((sb-ext:compiler-note #'error))
+    (let ((sb-ext:*evaluator-mode* :compile))
+      (eval '(let ((x 42))
+              (if nil x)))
+      (eval '(let ((* 13))
+              (let ((x 42)
+                    (y *))
+                (declare (optimize speed))
+                (+ x y)))))))
+
 ;;; success