better type propagation for MULTIPLE-VALUE-BIND

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

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 9c52b0f..2c73809 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2136,4 +2136,26 @@
     (assert (equal `(function () (values ,ufix &optional))
                    (%simple-fun-type fun)))))
 
+(test-util:with-test (:name :mv-bind-to-let-type-propagation)
+  (let ((f (compile nil `(lambda (x)
+                           (declare (optimize speed)
+                                    (type (integer 20 50) x))
+                           (< (truncate x 10) 1))))
+        (g (compile nil `(lambda (x)
+                           (declare (optimize speed)
+                                    (type (integer 20 50) x))
+                           (< (nth-value 1 (truncate x 10)) 10))))
+        (h (compile nil `(lambda (x)
+                           (declare (optimize speed)
+                                    (type (integer 20 50) x))
+                           (multiple-value-bind (q r)
+                               (truncate x 10)
+                             (declare (ignore r))
+                             (< q 1)))))
+        (type0 '(function ((integer 20 50)) (values null &optional)))
+        (type1 '(function ((integer 20 50)) (values (member t) &optional))))
+    (assert (equal type0 (sb-kernel:%simple-fun-type f)))
+    (assert (equal type1 (sb-kernel:%simple-fun-type g)))
+    (assert (equal type0 (sb-kernel:%simple-fun-type h)))))
+
 ;;; success