From bccd6a980c0ec805aa815f4d08e350c8bb60f4c0 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Sun, 18 Feb 2018 09:01:08 -0800
Subject: [PATCH] Fix #58: Bogus type error in comparison of complex number
 with `THE` form

The deftransforms `upgraded-complex-real-contagion-arg1` and
`upgraded-complex-real-contagion-arg2` were coercing the complex
number to the exact type of the float number.  Because of the `THE`
form, the type of the float was `(member 1d0)`, so the compiler was
coercing `#c(1/2 1/2)` to `(complex (double-float 1d0))`, which is
wrong.

Therefore, coerce the complex to just the type format of the real
part, ignoring any bounds.

* src/compiler/float-tran.lisp
  * Coerce to format type, discarding any bounds
* src/general-info/release-21d.md
  * Update notes
* tests/issues.lisp
  * Added test for this
---
 src/compiler/float-tran.lisp    | 4 ++--
 src/general-info/release-21d.md | 1 +
 tests/issues.lisp               | 6 ++++++
 3 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 3df41f4b8..93b88b7f5 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -1903,7 +1903,7 @@
 (deftransform upgraded-complex-real-contagion-arg1 ((x y) * * :defun-only t :node node)
   ;;(format t "upgraded-complex-real-contagion-arg1~%")
   `(,(continuation-function-name (basic-combination-fun node))
-     (coerce x '(complex ,(type-specifier (continuation-type y))))
+     (coerce x '(complex ,(numeric-type-format (continuation-type y))))
      y))
 ;;;
 (deftransform upgraded-complex-real-contagion-arg2 ((x y) * * :defun-only t :node node)
@@ -1912,7 +1912,7 @@
 	  (continuation-type x) (continuation-type y))
   `(,(continuation-function-name (basic-combination-fun node))
      x
-     (coerce y '(complex ,(type-specifier (continuation-type x))))))
+     (coerce y '(complex ,(numeric-type-format (continuation-type x))))))
 
 
 (dolist (x '(= + * / -))
diff --git a/src/general-info/release-21d.md b/src/general-info/release-21d.md
index b15456bb3..7940e53fb 100644
--- a/src/general-info/release-21d.md
+++ b/src/general-info/release-21d.md
@@ -34,6 +34,7 @@ public domain.
     * ~~#47~~ Backquate and multiple splices
     * ~~#59~~ Incorrect type-derivation for `decode-float`
     * ~~#60~~ The function `C::%UNARY-FROUND` is undefined
+    * ~~#58~~ Bogus type error in comparison of complex number with `THE` form
   * Other changes:
   * Improvements to the PCL implementation of CLOS:
   * Changes to building procedure:
diff --git a/tests/issues.lisp b/tests/issues.lisp
index 5458531c0..eda48a349 100644
--- a/tests/issues.lisp
+++ b/tests/issues.lisp
@@ -515,3 +515,9 @@
     (assert-equalp
      (values 2d0 0d0)
      (funcall c14 2d0))))
+
+(define-test issue.58
+  (:tag :issues)
+  (let ((c9 (compile nil #'(lambda (x)
+			     (= (the (eql 1.0d0) x) #c(1/2 1/2))))))
+    (assert-false (funcall c9 1.d0))))
-- 
GitLab