[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Fix crash in ctype-of-number, lp#1909881
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2021-01-12 17:04:59
Message-ID: 1610471099.841944.14019 () sfp-scm-1 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  baf85fe8b54e7085b0bfd731bb04fbac9037fd34 (commit)
      from  e976fefc2a166dc56b9b9c1d29a8773f0b81fe8d (commit)

- Log -----------------------------------------------------------------
commit baf85fe8b54e7085b0bfd731bb04fbac9037fd34
Author: Douglas Katzman <dougk@google.com>
Date:   Tue Jan 12 11:58:09 2021 -0500

    Fix crash in ctype-of-number, lp#1909881
---
 src/code/late-type.lisp | 16 ++++++++++++----
 tests/float.pure.lisp   |  3 +++
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 3739ea3b9..68f12a10c 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -4013,13 +4013,21 @@ used for a COMPLEX component.~:@>"
 
 ;;; This messy case of CTYPE for NUMBER is shared between the
 ;;; cross-compiler and the target system.
+;;; I'm not sure whether NaNs should be numeric types versus MEMBER (like
+;;; sigleton signed zero without the "other" sign), but it may not matter.
+;;; At a bare minimum this prevents crashing in min/max.
 (defun ctype-of-number (x)
   (let ((num (if (complexp x) (realpart x) x)))
     (multiple-value-bind (complexp low high)
-        (if (complexp x)
-            (let ((imag (imagpart x)))
-              (values :complex (sb-xc:min num imag) (sb-xc:max num imag)))
-            (values :real num num))
+        (cond ((complexp x)
+               (let ((imag (imagpart x)))
+                 (if (and (floatp num) (or (float-nan-p num) (float-nan-p imag)))
+                     (values :complex nil nil)
+                     (values :complex (sb-xc:min num imag) (sb-xc:max num imag)))))
+              ((and (floatp num) (float-nan-p num))
+               (values :real nil nil))
+              (t
+               (values :real num num)))
       (make-numeric-type :class (etypecase num
                                   (integer (if (complexp x)
                                                (if (integerp (imagpart x))
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index 3d6d099e9..0eaf0980c 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -593,3 +593,6 @@
       (setf (aref v 0) (ffloor (aref v 0) d))
       v)
    :allow-notes nil))
+
+(with-test (:name :ctype-of-nan)
+  (checked-compile '(lambda () #.(sb-kernel:make-single-float -1))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]