1.0.48.20: fix mv-call regression from 1.0.43.57

  Don't assert untrusted types when the values flow into an mv-call.

  Reported by Martin Kielhorn on sbcl-bugs 2011-05-21.

diff --git a/NEWS b/NEWS
index 9c4a0df..a4cdf76 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -20,6 +20,9 @@ changes relative to sbcl-1.0.48:
     from the to-char if the from-char is not a dispatch-macro character.
   * bug fix: references to undefined variables in function calls that are
     optimized away now signal a runtime error. (lp#722734)
+  * bug fix: miscompilation of MULTIPLE-VALUE-CALL when asserting derived
+    types from a function defined in the same file. (regression from
+    1.0.43.57)
 
 changes in sbcl-1.0.48 relative to sbcl-1.0.47:
   * incompatible change: SB!KERNEL:INSTANCE-LAMBDA, deprecated for over five

diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp
index 124b488..eddb7f1 100644 (file)
--- a/src/compiler/ctype.lisp
+++ b/src/compiler/ctype.lisp
@@ -864,13 +864,17 @@
     (if trusted
         (derive-node-type call returns)
         (let ((lvar (node-lvar call)))
-          ;; If the value is used in a non-tail position, and
-          ;; the lvar is a single-use, assert the type. Multiple use
-          ;; sites need to be elided because the assertion has to apply
-          ;; to all uses. Tail positions are elided because the assertion
-          ;; would lose cause us not the be in a tail-position anymore.
+          ;; If the value is used in a non-tail position, and the lvar
+          ;; is a single-use, assert the type. Multiple use sites need
+          ;; to be elided because the assertion has to apply to all
+          ;; uses. Tail positions are elided because the assertion
+          ;; would cause us not the be in a tail-position anymore. MV
+          ;; calls are elided because not only are the assertions of
+          ;; less use there, but they can cause the MV call conversion
+          ;; to cause astray.
           (when (and lvar
                      (not (return-p (lvar-dest lvar)))
+                     (not (mv-combination-p (lvar-dest lvar)))
                      (lvar-has-single-use-p lvar))
             (when (assert-lvar-type lvar returns policy)
               (reoptimize-lvar lvar)))))

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index edb4652..9da9acf 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -545,3 +545,16 @@
               (funcall (compile nil
                                 `(lambda ()
                                    (load-time-value (values 42))))))))
+
+(defun mv-call-regression-1.0.43.57-foo (a c d x y)
+  (values a c d x y))
+(defun mv-call-regression-1.0.43.57-bar (a b c d)
+  (declare (number a b c d))
+  (values a b c d))
+(defun mv-call-regression-1.0.43.57-quux (a sxx sxy syy)
+  (multiple-value-call #'mv-call-regression-1.0.43.57-foo
+    (mv-call-regression-1.0.43.57-bar sxx sxy sxy syy)
+    a))
+(test-util:with-test (:name :mv-call-regression-1.0.43.57)
+  ;; This used to signal a bogus argument-count error.
+  (mv-call-regression-1.0.43.57-quux 1s0 10s0 1s0 10s0))

diff --git a/version.lisp-expr b/version.lisp-expr
index ca0cebe..7794a0f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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".)
-"1.0.48.19"
+"1.0.48.20"