0.8.21.12: compiler message fixes
[sbcl.git] / tests / compiler.impure.lisp
index 33936a5..cf2a75e 100644 (file)
 ;;; BUG 48a. and b. (symbol-macrolet handling), fixed by Eric Marsden
 ;;; and Raymond Toy for CMUCL, fix ported for sbcl-0.7.6.18.
 (multiple-value-bind (function warnings-p failure-p)
-    (compile nil '(lambda () (symbol-macrolet ((t nil)) t)))
+    (compile nil '(lambda ()
+                   ;; not interested in the package lock violation here
+                   (declare (sb-ext:disable-package-locks t))
+                   (symbol-macrolet ((t nil)) t)))
   (assert failure-p)
   (assert (raises-error? (funcall function) program-error)))
 (multiple-value-bind (function warnings-p failure-p)
     (compile nil
             '(lambda ()
+               ;; not interested in the package lock violation here
+               (declare (sb-ext:disable-package-locks *standard-input*))
                (symbol-macrolet ((*standard-input* nil))
                  *standard-input*)))
   (assert failure-p)
 \f
 ;;;; MUFFLE-CONDITIONS test (corresponds to the test in the manual)
 (defvar *compiler-note-count* 0)
-#-alpha ; KLUDGE
+#-(or alpha x86-64) ; FIXME: make a better test!
 (handler-bind ((sb-ext:compiler-note (lambda (c)
                                       (declare (ignore c))
                                       (incf *compiler-note-count*))))
     (assert (= *compiler-note-count* 1))
     (assert (equal (multiple-value-list (funcall fun 1)) '(5 -5)))))
 \f
+(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)))
+\f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
 
          (grovel-results name))))))
 (identify-suspect-vops)
 \f
+;;;; tests for compiler output
+(let* ((*error-output* (make-broadcast-stream))
+       (output (with-output-to-string (*standard-output*)
+                (compile-file "compiler-output-test.lisp" 
+                              :print nil :verbose nil))))
+  (print output)
+  (assert (zerop (length output))))
+
 ;;; success
 (quit :unix-status 104)