From 71a725ca608022b916ccc61b9f8689d008ad9a75 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Fri, 12 Jan 2018 03:09:14 +0300
Subject: [PATCH] Fix derive-node-type on hairy types.

TYPE/= returns NIL when it's not sure, instead of checking the second
value negate the result of TYPE=.

Fixes lp#1742806
---
 src/compiler/ir1opt.lisp |  4 +++-
 tests/bad-code.pure.lisp | 10 ++++++++++
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index ed524b107..a89dbeb95 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -289,7 +289,9 @@
     (unless (eq initial-type rtype)
       (let ((int (values-type-intersection node-type rtype))
             (lvar (node-lvar node)))
-        (when (type/= initial-type int)
+        ;; Don't use type/=, it will return NIL on unknown types.
+        ;; Instead of checking the second value just negate TYPE=
+        (unless (type= initial-type int)
           (when (and *check-consistency*
                      (eq int *empty-type*)
                      (not (eq rtype *empty-type*)))
diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp
index cfa803e42..60633e06e 100644
--- a/tests/bad-code.pure.lisp
+++ b/tests/bad-code.pure.lisp
@@ -226,3 +226,13 @@
                '(lambda () (subseq (the (vector nonsense-type) :x) 0 1))
                :allow-warnings t
                :allow-style-warnings t))))
+(with-test (:name :derive-node-type-unknown-type)
+  (assert
+   (nth-value 3
+              (checked-compile
+               '(lambda (x)
+                 (let ((k (make-array 8 :element-type '(unsigned-byte 8))))
+                   (setf (aref k 0) (the unknown-type (the integer x)))
+                   (setf k (subseq "y" 0))))
+               :allow-warnings t
+               :allow-style-warnings t))))
-- 
2.11.4.GIT