From 6c1e23b7535e86697e518125f60550ecac82439d Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cantab.net>
Date: Mon, 3 Jun 2013 14:54:17 +0100
Subject: [PATCH] fixes in EXPT type derivation

It was possible to construct mostly (but not completely) unobservable
bogus floating-point types when deriving the type of functions
returning the value of calls to EXPT.  Noticed by Vsevolod Dyomkin,
who found a way to observe it by redefining methods.
---
 NEWS                         |    2 ++
 src/compiler/float-tran.lisp |   44 ++++++++++++++++++++++++++----------------
 tests/compiler.impure.lisp   |   11 +++++++++++
 3 files changed, 40 insertions(+), 17 deletions(-)

diff --git a/NEWS b/NEWS
index 0bcf148..36c42df 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,8 @@ changes relative to sbcl-1.1.8:
   * optimization: when referencing internal functions as #'x, don't go through
     an indirect fdefn structure.
   * optimization: SLEEP doesn't cons on non-immediate floats and on ratios.
+  * bug fix: EXPT type derivation no longer constructs bogus floating-point
+    types.  (reported by Vsevolod Dyomkin)
   
 changes in sbcl-1.1.8 relative to sbcl-1.1.7:
   * notice: The implementation of MAP-ALLOCATED-OBJECTS (the heart of
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 1877cef..51cf1dd 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -982,9 +982,12 @@
                                 (single-float ,f-lo, f-hi)))))
            (float
             ;; A positive integer to a float power is a float.
-            (modified-numeric-type y-type
-                                   :low (interval-low bnd)
-                                   :high (interval-high bnd)))
+            (let ((format (numeric-type-format y-type)))
+              (aver format)
+              (modified-numeric-type
+               y-type
+               :low (coerce-numeric-bound (interval-low bnd) format)
+               :high (coerce-numeric-bound (interval-high bnd) format))))
            (t
             ;; A positive integer to a number is a number (for now).
             (specifier-type 'number))))
@@ -1014,9 +1017,12 @@
                                 (single-float ,f-lo, f-hi)))))
            (float
             ;; A positive rational to a float power is a float.
-            (modified-numeric-type y-type
-                                   :low (interval-low bnd)
-                                   :high (interval-high bnd)))
+            (let ((format (numeric-type-format y-type)))
+              (aver format)
+              (modified-numeric-type
+               y-type
+               :low (coerce-numeric-bound (interval-low bnd) format)
+               :high (coerce-numeric-bound (interval-high bnd) format))))
            (t
             ;; A positive rational to a number is a number (for now).
             (specifier-type 'number))))
@@ -1026,20 +1032,24 @@
            ((or integer rational)
             ;; A positive float to an integer or rational power is
             ;; always a float.
-            (make-numeric-type
-             :class 'float
-             :format (numeric-type-format x-type)
-             :low (interval-low bnd)
-             :high (interval-high bnd)))
+            (let ((format (numeric-type-format x-type)))
+              (aver format)
+              (make-numeric-type
+               :class 'float
+               :format format
+               :low (coerce-numeric-bound (interval-low bnd) format)
+               :high (coerce-numeric-bound (interval-high bnd) format))))
            (float
             ;; A positive float to a float power is a float of the
             ;; higher type.
-            (make-numeric-type
-             :class 'float
-             :format (float-format-max (numeric-type-format x-type)
-                                       (numeric-type-format y-type))
-             :low (interval-low bnd)
-             :high (interval-high bnd)))
+            (let ((format (float-format-max (numeric-type-format x-type)
+                                            (numeric-type-format y-type))))
+              (aver format)
+              (make-numeric-type
+               :class 'float
+               :format format
+               :low (coerce-numeric-bound (interval-low bnd) format)
+               :high (coerce-numeric-bound (interval-high bnd) format))))
            (t
             ;; A positive float to a number is a number (for now)
             (specifier-type 'number))))
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 29eb6c3..fe4f6c3 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2418,4 +2418,15 @@
                    (call-1035721 #'identity-1035721)
                    (lambda (x)
                      (identity-1035721 x))))))
+
+(test-util:with-test (:name :expt-type-derivation-and-method-redefinition)
+  (defmethod expt-type-derivation ((x list) &optional (y 0.0))
+    (declare (type float y))
+    (expt 2 y))
+  ;; the redefinition triggers a type lookup of the old
+  ;; fast-method-function's type, which had a bogus type specifier of
+  ;; the form (double-float 0) from EXPT type derivation
+  (defmethod expt-type-derivation ((x list) &optional (y 0.0))
+    (declare (type float y))
+    (expt 2 y)))
 ;;; success
-- 
1.7.10.4