From: Alexey Dejneka <adejneka@comail.ru>
Date: Sun, 2 May 2004 14:03:48 +0000 (+0000)
Subject: 0.8.10.5:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=20caa346e7b57cf8876cf67e166711f574b8955a;p=sbcl.git

0.8.10.5:
        * Fix MISC.361: forbid conversion of a single-value CAST
          argument into UVL.
---

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 6fe4c36..988348d 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1773,7 +1773,9 @@
           ;; FIXME: Do it in one step.
           (filter-lvar
            value
-           `(multiple-value-call #'list 'dummy))
+           (if (cast-single-value-p cast)
+               `(list 'dummy)
+               `(multiple-value-call #'list 'dummy)))
           (filter-lvar
            (cast-value cast)
            ;; FIXME: Derived type.
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 95f2e3f..b86ce53 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -494,6 +494,10 @@
 (defun ctran-home-lambda (ctran)
   (ctran-home-lambda-or-null ctran))
 
+(declaim (inline cast-single-value-p))
+(defun cast-single-value-p (cast)
+  (not (values-type-p (cast-asserted-type cast))))
+
 #!-sb-fluid (declaim (inline lvar-single-value-p))
 (defun lvar-single-value-p (lvar)
   (or (not lvar)
@@ -506,7 +510,7 @@
           (cast
            (locally
                (declare (notinline lvar-single-value-p))
-             (and (not (values-type-p (cast-asserted-type dest)))
+             (and (cast-single-value-p dest)
                   (lvar-single-value-p (node-lvar dest)))))
           (t
            t)))))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 2810dee..11c73a3 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1181,6 +1181,27 @@
                (catch 'ct1 (throw 'ct1 0))))))
          15867134))
 
+;;; misc.361: replacing CAST with (m-v-call #'%compile-time-type-error)
+;;; could transform known-values LVAR to UVL
+(assert (zerop (funcall
+   (compile
+    nil
+    '(lambda (a b c)
+       (declare (notinline boole values denominator list))
+       (declare
+	(optimize (speed 2)
+		  (space 0)
+		  (safety 1)
+		  (debug 0)
+		  (compilation-speed 2)))
+       (catch 'ct6
+	 (progv
+	     '(*s8*)
+	     (list 0)
+	   (let ((v9 (ignore-errors (throw 'ct6 0))))
+	     (denominator
+	      (progv nil nil (values (boole boole-and 0 v9)))))))))
+   1 2 3)))
 
 ;;; MISC.275
 (assert
diff --git a/version.lisp-expr b/version.lisp-expr
index 5e6ae43..eefeb8f 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.10.4"
+"0.8.10.5"