X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=6e4ee6dd60dab4817809eda6af535255ca5ceb34;hb=64ec717cf13c44fb4571c1fd7fbd508551ecfe01;hp=18622e1f4677124072d2d4d6e02cc6754ab440b4;hpb=c3699db2053ff3b5ac6a98d4431c3789496002d8;p=sbcl.git

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 18622e1..6e4ee6d 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -871,6 +871,26 @@
     (truncate (expt a b))))
 (assert (equal (multiple-value-list (expt-derive-type-bug 1 1))
 	       '(1 0)))
+
+;;; Problems with type checking in functions with EXPLICIT-CHECK
+;;; attribute (reported by Peter Graves)
+(loop for (fun . args) in '((= a) (/= a)
+                            (< a) (<= a) (> a) (>= a))
+      do (assert (raises-error? (apply fun args) type-error)))
+
+(defclass broken-input-stream (sb-gray:fundamental-input-stream) ())
+(defmethod sb-gray:stream-read-char ((stream broken-input-stream))
+  (throw 'break :broken))
+(assert (eql (block return
+               (handler-case
+                   (catch 'break
+                     (funcall (eval ''peek-char)
+                              1 (make-instance 'broken-input-stream))
+                     :test-broken)
+                 (type-error (c)
+                   (return-from return :good))))
+             :good))
+
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself