From 959cdc5a9dcead1903ca3cafdeeb9c95cc593fc3 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Tue, 23 Jan 2018 23:23:29 +0300
Subject: [PATCH] Handle (complex (member not-a-real)) types.

Produce an error instead of exhausting the stack.

Fixes lp#1745000
---
 src/code/late-type.lisp  | 5 ++++-
 tests/bad-code.pure.lisp | 7 +++++++
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index d2b7fbb2e..33a7fed10 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2068,7 +2068,10 @@
                    ((typep ctype 'member-type)
                     (apply #'type-union
                            (mapcar-member-type-members
-                            (lambda (x) (do-complex (ctype-of x)))
+                            (lambda (x)
+                              (if (realp x)
+                                  (do-complex (ctype-of x))
+                                  (not-real)))
                             ctype)))
                    ((and (typep ctype 'intersection-type)
                          ;; FIXME: This is very much a
diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp
index 049472642..2a33a7422 100644
--- a/tests/bad-code.pure.lisp
+++ b/tests/bad-code.pure.lisp
@@ -250,3 +250,10 @@
                                         t)))
                            (macro)))
                       :allow-warnings t))))
+
+(with-test (:name :complex-member-type)
+  (assert (nth-value 2
+                     (checked-compile
+                      `(lambda (x)
+                         (typep x '(complex (eql t))))
+                      :allow-warnings t))))
-- 
2.11.4.GIT