[Sbcl-commits] CVS: sbcl/tests compiler.impure.lisp,1.51,1.52 compiler.pure.lisp,1.80,1.81

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv955/tests

Modified Files:
	compiler.impure.lisp compiler.pure.lisp 
Log Message:
0.8.7.8:
        * Fix argument type checking in =, /=, <, <=, >, >=,
          PEEK-CHAR. (reported by Peter Graves).



Index: compiler.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -d -r1.51 -r1.52
--- compiler.impure.lisp	5 Dec 2003 16:56:21 -0000	1.51
+++ compiler.impure.lisp	7 Jan 2004 09:10:33 -0000	1.52
@@ -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

Index: compiler.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -d -r1.80 -r1.81
--- compiler.pure.lisp	4 Jan 2004 17:43:06 -0000	1.80
+++ compiler.pure.lisp	7 Jan 2004 09:10:33 -0000	1.81
@@ -1031,4 +1031,5 @@
                             (compilation-speed 1)))
          (logand a (* a 438810))))
      215067723)
-    13739018))
\ No newline at end of file
+    13739018))
+