0.8.7.13:

[sbcl.git] / tests / compiler.impure.lisp

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index a1166ab..6e4ee6d 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -845,6 +845,52 @@
   (declare (optimize (speed 0) (safety 3) (space 0)
                      (debug 1) (compilation-speed 0)))
   (adjoin a b))
+
+;;; bug reported by Doug McNaught on sbcl-devel 2003-09-14:
+;;; COMPILE-FILE did not bind *READTABLE*
+(let* ((source "bug-doug-mcnaught-20030914.lisp")
+       (fasl (compile-file-pathname source)))
+  (labels ((check ()
+             (assert (null (get-macro-character #\]))))
+           (full-check ()
+             (check)
+             (assert (typep *bug-doug-mcnaught-20030914*
+                            '(simple-array (unsigned-byte 4) (*))))
+             (assert (equalp *bug-doug-mcnaught-20030914* #(1 2 3)))
+             (makunbound '*bug-doug-mcnaught-20030914*)))
+    (compile-file source)
+    (check)
+    (load fasl)
+    (full-check)
+    (load source)
+    (full-check)
+    (delete-file fasl)))
+\f
+(defun expt-derive-type-bug (a b)
+  (unless (< a b)
+    (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))
+
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself