[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Add more NaN tests

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl


Commits:
29cd0082 by Raymond Toy at 2023-03-14T13:02:52-07:00
Add more NaN tests

Add tests to verify that we handle NaNs correctly in comparisons.
This includes adding tests for <= and >=, and also updating the
existing tests for < and > to handle NaN in the second or third arg.

- - - - -


1 changed file:

- tests/nan.lisp


Changes:

=====================================
tests/nan.lisp
=====================================
@@ -34,7 +34,11 @@
     (frob double-float <)
     (frob double-float >)
     (frob single-float =)
-    (frob double-float =)))
+    (frob double-float =)
+    (frob single-float >=)
+    (frob double-float >=)
+    (frob single-float <=)
+    (frob double-float <=)))
 
 (define-test nan-single.<
     (:tag :nan)
@@ -101,7 +105,10 @@
   (ext:with-float-traps-masked (:invalid)
     (assert-false (stst-<3 *single-float-nan* 2f0 3f0))
     (assert-false (stst-<3 1f0 *single-float-nan* 3f0))
-    (assert-false (stst-<3 *single-float-nan* *single-float-nan* 3f0))))
+    (assert-false (stst-<3 *single-float-nan* *single-float-nan* 3f0))
+    (assert-false (stst-<3 1f0 2f0 *single-float-nan*))
+    (assert-false (stst-<3 1f0 *single-float-nan* 3f0))
+    (assert-false (stst-<3 1f0 *single-float-nan* *single-float-nan*))))
   
 (define-test nan-double.<3
     (:tag :nan)
@@ -120,7 +127,10 @@
   (ext:with-float-traps-masked (:invalid)
     (assert-false (dtst-<3 *double-float-nan* 2d0 3d0))
     (assert-false (dtst-<3 1d0 *double-float-nan* 3d0))
-    (assert-false (dtst-<3 *double-float-nan* *double-float-nan* 3d0))))
+    (assert-false (dtst-<3 *double-float-nan* *double-float-nan* 3d0))
+    (assert-false (dtst-<3 1d0 2d0 *double-float-nan*))
+    (assert-false (dtst-<3 1d0 *double-float-nan* 3d0))
+    (assert-false (dtst-<3 1d0 *double-float-nan* *double-float-nan*))))
   
 (define-test nan-single.>3
     (:tag :nan)
@@ -139,7 +149,10 @@
   (ext:with-float-traps-masked (:invalid)
     (assert-false (stst->3 *single-float-nan* 2f0 3f0))
     (assert-false (stst->3 1f0 *single-float-nan* 3f0))
-    (assert-false (stst->3 *single-float-nan* *single-float-nan* 3f0))))
+    (assert-false (stst->3 *single-float-nan* *single-float-nan* 3f0))
+    (assert-false (stst->3 1f0 2f0 *single-float-nan*))
+    (assert-false (stst->3 1f0 *single-float-nan* 3f0))
+    (assert-false (stst->3 1f0 *single-float-nan* *single-float-nan*))))
   
 (define-test nan-double.>3
     (:tag :nan)
@@ -158,7 +171,118 @@
   (ext:with-float-traps-masked (:invalid)
     (assert-false (dtst->3 *double-float-nan* 2d0 3d0))
     (assert-false (dtst->3 1d0 *double-float-nan* 3d0))
-    (assert-false (dtst->3 *double-float-nan* *double-float-nan* 3d0))))
+    (assert-false (dtst->3 *double-float-nan* *double-float-nan* 3d0))
+    (assert-false (dtst->3 1d0 2d0 *double-float-nan*))
+    (assert-false (dtst->3 1d0 *double-float-nan* 3d0))
+    (assert-false (dtst->3 1d0 *double-float-nan* *double-float-nan*))))
+  
+(define-test nan-single.>=
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (stst->= 1f0 1f0))
+  (assert-true (stst->= 2f0 1f0))
+  (assert-false (stst->= 0f0 1f0))
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst->= 1f0 *single-float-nan*))
+    (assert-false (stst->= *single-float-nan* 1f0))
+    (assert-false (stst->= *single-float-nan* *single-float-nan*))))
+  
+(define-test nan-single.<=
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (stst-<= 1f0 1f0))
+  (assert-true (stst-<= 1f0 2f0))
+  (assert-false (stst-<= 2f0 1f0))
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-<= 1f0 *single-float-nan*))
+    (assert-false (stst-<= *single-float-nan* 1f0))
+    (assert-false (stst-<= *single-float-nan* *single-float-nan*))))
+  
+(define-test nan-single.>=3
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (stst->=3 1f0 1f0 1f0))
+  (assert-true (stst->=3 2f0 1f0 1f0))
+  (assert-false (stst->=3 0f0 1f0 1f0))
+  (assert-false (stst->=3 2f0 0f0 1f0))
+  
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst->=3 1f0 *single-float-nan* 2f0))
+    (assert-false (stst->=3 *single-float-nan* 1f0 2f0))
+    (assert-false (stst->=3 *single-float-nan* *single-float-nan* 2f0))
+    (assert-false (stst->=3 2f0 1f0 *single-float-nan*))
+    (assert-false (stst->=3 2f0 *single-float-nan* 1f0))
+    (assert-false (stst->=3 2f0 *single-float-nan* *single-float-nan*))))
+  
+(define-test nan-single.<=3
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (stst-<=3 1f0 1f0 1f0))
+  (assert-true (stst-<=3 1f0 2f0 2f0))
+  (assert-false (stst-<=3 1f0 3f0 2f0))
+  (assert-false (stst-<=3 2f0 1f0 1f0))
+
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (stst-<=3 1f0 *single-float-nan* 2f0))
+    (assert-false (stst-<=3 *single-float-nan* 1f0 2f0))
+    (assert-false (stst-<=3 *single-float-nan* *single-float-nan* 2f0))
+    (assert-false (stst-<=3 1f0 2f0 *single-float-nan*))
+    (assert-false (stst-<=3 1f0 *single-float-nan* 1f0))
+    (assert-false (stst-<=3 1f0 *single-float-nan* *single-float-nan*))))
+  
+(define-test nan-double.>=
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (dtst->= 1f0 1f0))
+  (assert-true (dtst->= 2f0 1f0))
+  (assert-false (dtst->= 0f0 1f0))
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst->= 1f0 *double-float-nan*))
+    (assert-false (dtst->= *double-float-nan* 1f0))
+    (assert-false (dtst->= *double-float-nan* *double-float-nan*))))
+  
+(define-test nan-double.<=
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (dtst-<= 1f0 1f0))
+  (assert-true (dtst-<= 1f0 2f0))
+  (assert-false (dtst-<= 2f0 1f0))
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst-<= 1f0 *double-float-nan*))
+    (assert-false (dtst-<= *double-float-nan* 1f0))
+    (assert-false (dtst-<= *double-float-nan* *double-float-nan*))))
+  
+(define-test nan-double.>=3
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (dtst->=3 1d0 1d0 1d0))
+  (assert-true (dtst->=3 2d0 1d0 1d0))
+  (assert-false (dtst->=3 0d0 1d0 1d0))
+  (assert-false (dtst->=3 2d0 0d0 1d0))
+  
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst->=3 1d0 *double-float-nan* 2d0))
+    (assert-false (dtst->=3 *double-float-nan* 1d0 2d0))
+    (assert-false (dtst->=3 *double-float-nan* *double-float-nan* 2d0))
+    (assert-false (dtst->=3 2d0 1d0 *double-float-nan*))
+    (assert-false (dtst->=3 2d0 *double-float-nan* 1d0))
+    (assert-false (dtst->=3 2d0 *double-float-nan* *double-float-nan*))))
+  
+(define-test nan-double.<=3
+    (:tag :nan)
+  :Basic tests with regular numbers
+  (assert-true (dtst-<=3 1d0 1d0 1d0))
+  (assert-true (dtst-<=3 1d0 2d0 2d0))
+  (assert-false (dtst-<=3 1d0 3d0 2d0))
+  (assert-false (dtst-<=3 2d0 1d0 1d0))
+
+  (ext:with-float-traps-masked (:invalid)
+    (assert-false (dtst-<=3 1d0 *double-float-nan* 2d0))
+    (assert-false (dtst-<=3 *double-float-nan* 1d0 2d0))
+    (assert-false (dtst-<=3 *double-float-nan* *double-float-nan* 2d0))
+    (assert-false (dtst-<=3 1d0 2d0 *double-float-nan*))
+    (assert-false (dtst-<=3 1d0 *double-float-nan* 1d0))
+    (assert-false (dtst-<=3 1d0 *double-float-nan* *double-float-nan*))))
   
 (define-test nan-single.=
     (:tag :nan)



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/29cd008228a0d93a40a3803d5820997e32a72112

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/29cd008228a0d93a40a3803d5820997e32a72112
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230314/c5b30bb7/attachment-0001.html>