From: Alexey Dejneka <adejneka@comail.ru>
Date: Fri, 29 Aug 2003 08:45:38 +0000 (+0000)
Subject: 0.8.3.11:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=c58795f37078f5900aff5dc4a3712fbadd2d432e;p=sbcl.git

0.8.3.11:
        * New bug 282;
        * remove bug entry 233a;
        ... add a test for it.
---

diff --git a/BUGS b/BUGS
index 3bd05e6..6b0a4f3 100644
--- a/BUGS
+++ b/BUGS
@@ -824,20 +824,6 @@ WORKAROUND:
   produce invalid code, but type checking is not accurate.)
 
 233: bugs in constraint propagation
-  a.
-  (defun foo (x)
-    (declare (optimize (speed 2) (safety 3)))
-    (let ((y 0d0))
-      (values
-       (the double-float x)
-       (setq y (+ x 1d0))
-       (setq x 3d0)
-       (quux y (+ y 2d0) (* y 3d0)))))
-  (foo 4) => segmentation violation
-
-  (see usage of CONTINUATION-ASSERTED-TYPE in USE-RESULT-CONSTRAINTS)
-  (see also bug 236)
-
   b.
   (declaim (optimize (speed 2) (safety 3)))
   (defun foo (x y)
@@ -1196,6 +1182,16 @@ WORKAROUND:
   The issue seems to be that construction of a discriminating function
   calls COMPUTE-EFFECTIVE-METHOD with methods that are not all applicable.
 
+282: "type checking in full calls"
+  In current (0.8.3.6) implementation a CAST in a full call argument
+  is not checked; but the continuation between the CAST and the
+  combination has the "checked" type and CAST performs unsafe
+  coercion; this may lead to errors: if FOO is declared to take a
+  FIXNUM, this code will produce garbage on a machine with 30-bit
+  fixnums:
+
+    (foo (aref (the (array (unsigned-byte 32)) x)))
+
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
     These labels were used for bugs related to the old IR1 interpreter.
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 17b51ee..e155afd 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -44,10 +44,6 @@
 ;;;
 ;;; -- this code does not check whether SET appears between REF and a
 ;;; test (bug 233b)
-;;;
-;;; -- type check is assumed to be inserted immediately after a node
-;;; producing the value; it disagrees with the rest of Python (bug
-;;; 233a)
 
 (in-package "SB!C")
 
diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index d5e660e..5982b02 100644
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -1,3 +1,6 @@
+(load "assertoid.lisp")
+(use-package "ASSERTOID")
+
 ;;; bug 254: compiler falure
 (defpackage :bug254 (:use :cl))
 (in-package :bug254)
@@ -139,5 +142,16 @@
 
 (delete-package :bug258)
 
+;;;
+(defun bug233a (x)
+  (declare (optimize (speed 2) (safety 3)))
+  (let ((y 0d0))
+    (values
+     (the double-float x)
+     (setq y (+ x 1d0))
+     (setq x 3d0)
+     (funcall (eval ''list) y (+ y 2d0) (* y 3d0)))))
+(assert (raises-error? (bug233a 4) type-error))
+
 
 (sb-ext:quit :unix-status 104)
diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index 3f913cf..e1cba00 100644
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -59,3 +59,28 @@
                              (symbol-value 'a))
                        a b)
                  '(1 2 :a 1 2))))
+
+;;; bug 282
+;;;
+;;; Verify type checking policy in full calls: the callee is supposed
+;;; to perform check, but the results should not be used before the
+;;; check will be actually performed.
+#+nil
+(locally
+    (declare (optimize (safety 3)))
+  (flet ((bar (f a)
+           (declare (type (simple-array (unsigned-byte 32) (*)) a))
+           (declare (type (function (fixnum)) f))
+           (funcall f (aref a 0))))
+    (assert
+     (eval `(let ((n (1+ most-positive-fixnum)))
+              (if (not (typep n '(unsigned-byte 32)))
+                  (warn 'style-warning
+                        "~@<This test is written for platforms with ~
+                        ~@<(proper-subtypep 'fixnum '(unsigned-byte 32))~:@>.~:@>")
+                  (block nil
+                    (funcall ,#'bar
+                             (lambda (x) (when (eql x n) (return t)))
+                             (make-array 1 :element-type '(unsigned-byte 32)
+                                         :initial-element n))
+                    nil)))))))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 9805867..948d419 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -512,10 +512,11 @@
 ;;; We suppose that INTEGER arithmetic cannot be efficient, and the
 ;;; compiler has an optimized VOP for +; so this code should cause an
 ;;; efficiency note.
-(assert (eq (handler-case
-                (compile nil '(lambda (i)
-                               (declare (optimize speed))
-                               (declare (type integer i))
-                               (+ i 2)))
-              (sb-ext:compiler-note (c) (return :good)))
+(assert (eq (block nil
+              (handler-case
+                  (compile nil '(lambda (i)
+                                 (declare (optimize speed))
+                                 (declare (type integer i))
+                                 (+ i 2)))
+                (sb-ext:compiler-note (c) (return :good))))
             :good))
diff --git a/version.lisp-expr b/version.lisp-expr
index e7129a4..6a80a42 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.3.10"
+"0.8.3.11"