From 5d4242c62bcb77e1fd0dcb147e4ea8923a4bf076 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 22 Dec 2016 08:05:12 +0100
Subject: [PATCH] tests: add tests for ieee-fp and atan2

Corner cases (bug #332).
---
 src/tests/normal-tests/ieee-fp.lsp | 106 +++++++++++++++++++++++++++++
 1 file changed, 106 insertions(+)

diff --git a/src/tests/normal-tests/ieee-fp.lsp b/src/tests/normal-tests/ieee-fp.lsp
index 4582d8025..028f59403 100644
--- a/src/tests/normal-tests/ieee-fp.lsp
+++ b/src/tests/normal-tests/ieee-fp.lsp
@@ -65,3 +65,109 @@
   (finishes (> ext:double-float-negative-infinity (1+ most-positive-fixnum)))
   (finishes (< (1+ most-positive-fixnum) ext:double-float-negative-infinity))
   (finishes (> (1+ most-positive-fixnum) ext:double-float-negative-infinity)))
+
+
+;;; Reported by: Raymond Toy
+;;; Test corner-cases of calculating atan2
+;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/issues/332
+
+(defparameter *ieee-fp.negative-inf*
+  (list ext:short-float-negative-infinity
+        ext:single-float-negative-infinity
+        ext:double-float-negative-infinity
+        ext:long-float-negative-infinity))
+
+(defparameter *ieee-fp.positive-inf*
+  (list ext:short-float-positive-infinity
+        ext:single-float-positive-infinity
+        ext:double-float-positive-infinity
+        ext:long-float-positive-infinity))
+
+(defparameter *ieee-fp.inf*
+  (list ext:short-float-negative-infinity
+        ext:single-float-negative-infinity
+        ext:double-float-negative-infinity
+        ext:long-float-negative-infinity
+        ext:short-float-positive-infinity
+        ext:single-float-positive-infinity
+        ext:double-float-positive-infinity
+        ext:long-float-positive-infinity))
+
+(defparameter *ieee-fp.anything*
+  (append *floats*
+          (list -0.0 +0.0 (si:nan))
+          *ieee-fp.inf*))
+
+(defparameter *ieee-fp.anything/but-nan*
+  (remove-if #'si::float-nan-p *ieee-fp.anything*))
+
+(defparameter *ieee-fp.anything/but-0+nan*
+  (remove-if (lambda (x)
+               (or (si::float-nan-p x)
+                   (si::zerop x)))
+             *ieee-fp.anything*))
+
+(defparameter *ieee-fp.anything/but-inf+nan*
+  (remove-if (lambda (x)
+               (or (si::float-nan-p x)
+                   (si::float-infinity-p x)))
+             *ieee-fp.anything*))
+
+(defparameter *ieee-fp.anything/but-0+inf+nan*
+  (remove-if (lambda (x)
+               (or (si::float-nan-p x)
+                   (si::float-infinity-p x)
+                   (zerop x)))
+             *ieee-fp.anything*))
+
+(defun pip (my-pi number)
+  (<= (abs (- (abs my-pi) (abs number))) 0.01))
+
+(test ieee-fp.0004.atan2-special-cases.nan-arg
+  (without-fpe-traps
+    ;; (atan (anything) nan) -> nan
+    ;; (atan nan (anything)) -> nan
+    (map () (lambda (n)
+              (is (si:float-nan-p (atan n (si:nan))))
+              (is (si:float-nan-p (atan (si:nan) n))))
+         *ieee-fp.anything*)))
+
+(test ieee-fp.0005.atan2-special-case.zero-arg
+  ;; (atan +-0 +(anything-but-nan))  -> +-0
+  ;; (atan +-0 -(anything-but-nan))  -> +-pi
+  (map () (lambda (n)
+            (is (zerop (atan -0.0 n)))
+            (is (zerop (atan +0.0 n)))
+            (is (pip pi (atan +0.0 (- n))))
+            (is (pip pi (atan -0.0 (- n)))))
+       (remove-if-not #'plusp *ieee-fp.anything/but-nan*))
+  ;; (atan +-(anything-but-0/nan) 0) -> +-pi/2
+  (map () (lambda (n)
+            (is (pip (* +1/2 pi) (atan n +0.0)))
+            (is (pip (* -1/2 pi) (atan n -0.0))))
+       *ieee-fp.anything/but-0+nan*))
+
+(test ieee-fp.0006.atan2-special-case.inf-arg
+  ;; (atan +-inf +inf) -> +-pi/4
+  (map () (lambda (n)
+            (map () (lambda (m) (is (pip (/ pi 4) (atan n m))))
+                 *ieee-fp.positive-inf*))
+       *ieee-fp.inf*)
+  ;; (atan +-inf -inf) -> +-3pi/4
+  (map () (lambda (n)
+            (map () (lambda (m) (is (pip (* 3/4 pi) (atan n m))))
+                 *ieee-fp.negative-inf*))
+       *ieee-fp.inf*)
+  (map () (lambda (n)
+            ;; (atan +-(anything-but-inf/nan), +inf) -> +-0
+            (map () (lambda (m) (is (zerop (atan n m))))
+                 *ieee-fp.positive-inf*)
+            ;; (atan +-(anything-but-inf/nan), -inf) -> +-pi
+            (map () (lambda (m) (is (pip pi (atan n m))))
+                 *ieee-fp.negative-inf*))
+       *ieee-fp.anything/but-inf+nan*)
+  ;; (atan +-inf (anything-but-0/nan/inf)) -> +-pi/2
+  (map () (lambda (n)
+            (map () (lambda (m) (is (pip (/ pi 2) (atan m n))))
+                 *ieee-fp.inf*))
+       *ieee-fp.anything/but-0+inf+nan*))