X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=f94e582ec1f0cf82e8fafa4444d052953419f8f6;hb=7abb9e44907ef12b52ac26d6482fbe21c036ee9b;hp=6e4ee6dd60dab4817809eda6af535255ca5ceb34;hpb=8b0f847a56feacdfcbc8dae20cdc84bb91bf4c98;p=sbcl.git

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 6e4ee6d..f94e582 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -890,7 +890,34 @@
                  (type-error (c)
                    (return-from return :good))))
              :good))
-
+
+;;;; MUFFLE-CONDITIONS test (corresponds to the test in the manual)
+(defvar *compiler-note-count* 0)
+#-alpha ; FIXME: make a better test!
+(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)))))
+
+(handler-case
+    (eval '(flet ((%f (&key) nil)) (%f nil nil)))
+  (error (c) :good)
+  (:no-error (val) (error "no error: ~S" val)))
+(handler-case
+    (eval '(labels ((%f (&key x) x)) (%f nil nil)))
+  (error (c) :good)
+  (:no-error (val) (error "no error: ~S" val)))
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself