Update tests for **_close,

zoziha · zoziha · commit 268cedc522c7 · 2021-12-08T17:38:58.000+08:00
1.0e-9 -&gt; sqrt(epsilon(..))
diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md
@@ -393,13 +393,13 @@ end program demo_math_arange
 
 #### Description
 
-Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance, behaves like `isclose` in Python stdlib.
+Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance.
 
 ```fortran
 !> For `real` type
 is_close(a, b, rel_tol, abs_tol) = abs(a - b) <= max(rel_tol*(abs(a), abs(b)), abs_tol)
 
-!> For `complex` type
+!> and for `complex` type
 is_close(a, b, rel_tol, abs_tol) = is_close(a%re, b%re, rel_tol, abs_tol) .and. &
                                    is_close(a%im, b%im, rel_tol, abs_tol)
 ```
@@ -418,24 +418,26 @@ Elemental function.
 
 #### Arguments
 
+Note: All `real/complex` arguments must have same `kind`.  
+If the value of `rel_tol/abs_tol` is negative (not recommended), 
+it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `is_close`.
+
 `a`: Shall be a `real/complex` scalar/array.
 This argument is `intent(in)`.
 
 `b`: Shall be a `real/complex` scalar/array.
 This argument is `intent(in)`.
 
 `rel_tol`: Shall be a `real` scalar/array.
-This argument is `intent(in)` and `optional`, which is `1.0e-9` by default.
+This argument is `intent(in)` and `optional`, which is `sqrt(epsilon(..))` by default.
 
 `abs_tol`: Shall be a `real` scalar/array.
 This argument is `intent(in)` and `optional`, which is `0.0` by default.
 
 `equal_nan`: Shall be a `logical` scalar/array.
 This argument is `intent(in)` and `optional`, which is `.false.` by default.
-
-Note: All `real/complex` arguments must have same `kind`.  
-If the value of `rel_tol/abs_tol` is negative (not recommended), 
-it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `is_close`.
+Whether to compare `NaN` values as equal. If `.true.`, 
+`NaN` values in `a` will be considered equal to `NaN` values in `b`.
 
 #### Result value
 
@@ -457,9 +459,6 @@ program demo_math_is_close
     print *, is_close(2.0, 2.1, abs_tol=0.1)    !! T
     print *, NAN, is_close(2.0, NAN), is_close(2.0, NAN, equal_nan=.true.)   !! NAN, F, F
     print *, is_close(NAN, NAN), is_close(NAN, NAN, equal_nan=.true.)        !! F, T
-    
-    call check(all(is_close(x, [2.0, 2.0])), msg="all(is_close(x, [2.0, 2.0])) failed.", warn=.true.)
-            !! all(is_close(x, [2.0, 2.0])) failed.
         
 end program demo_math_is_close
 ```
@@ -468,7 +467,7 @@ end program demo_math_is_close
 
 #### Description
 
-Returns a boolean scalar where two arrays are element-wise equal within a tolerance, behaves like `all(is_close(a, b [, rel_tol, abs_tol, equal_nan]))`.
+Returns a boolean scalar where two arrays are element-wise equal within a tolerance.
 
 #### Syntax
 
@@ -484,24 +483,26 @@ Pure function.
 
 #### Arguments
 
+Note: All `real/complex` arguments must have same `kind`.  
+If the value of `rel_tol/abs_tol` is negative (not recommended), 
+it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`.
+
 `a`: Shall be a `real/complex` array.
 This argument is `intent(in)`.
 
 `b`: Shall be a `real/complex` array.
 This argument is `intent(in)`.
 
 `rel_tol`: Shall be a `real` scalar.
-This argument is `intent(in)` and `optional`, which is `1.0e-9` by default.
+This argument is `intent(in)` and `optional`, which is `sqrt(epsilon(..))` by default.
 
 `abs_tol`: Shall be a `real` scalar.
 This argument is `intent(in)` and `optional`, which is `0.0` by default.
 
 `equal_nan`: Shall be a `logical` scalar.
 This argument is `intent(in)` and `optional`, which is `.false.` by default.
-
-Note: All `real/complex` arguments must have same `kind`.  
-If the value of `rel_tol/abs_tol` is negative (not recommended), 
-it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`.
+Whether to compare `NaN` values as equal. If `.true.`, 
+`NaN` values in `a` will be considered equal to `NaN` values in `b`.
 
 #### Result value
 
@@ -524,10 +525,6 @@ program demo_math_all_close
     print *, all_close(z+cmplx(1.0e-11, 1.0e-11), z)     !! T
     print *, NAN, all_close([NAN], [NAN]), all_close([NAN], [NAN], equal_nan=.true.) 
                                                          !! NAN, F, T
-                                                
-    call check(all_close(x, [2.0, 2.0], rel_tol=1.0e-6, abs_tol=1.0e-3), &
-               msg="all_close(x, [2.0, 2.0]) failed.", warn=.true.)
-               !! all_close(x, [2.0, 2.0]) failed.
     
 end program demo_math_all_close
 ```
diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp
@@ -297,7 +297,7 @@ module stdlib_math
     !> Version: experimental
     !>
     !> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance.
-    !> ([Specification](../page/specs/stdlib_logic.html#is_close))
+    !> ([Specification](../page/specs/stdlib_math.html#is_close))
     interface is_close
         #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
         #:for k1, t1 in RC_KINDS_TYPES
@@ -312,7 +312,7 @@ module stdlib_math
     !> Version: experimental
     !>
     !> Returns a boolean scalar where two arrays are element-wise equal within a tolerance.
-    !> ([Specification](../page/specs/stdlib_logic.html#all_close))
+    !> ([Specification](../page/specs/stdlib_math.html#all_close))
     interface all_close
         #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
         #:set RANKS = range(1, MAXRANK + 1)
diff --git a/src/stdlib_math_is_close.fypp b/src/stdlib_math_is_close.fypp
@@ -5,6 +5,10 @@ submodule(stdlib_math) stdlib_math_is_close
     use, intrinsic :: ieee_arithmetic, only: ieee_is_nan
     implicit none
     
+    #:for k1 in REAL_KINDS
+    real(${k1}$), parameter :: sqrt_eps_${k1}$ = sqrt(epsilon(1.0_${k1}$))
+    #:endfor
+    
 contains
 
     #! Determines whether the values of `a` and `b` are close.
@@ -21,7 +25,7 @@ contains
         if (ieee_is_nan(a) .or. ieee_is_nan(b)) then
             close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b))
         else
-            close = abs(a - b) <= max( abs(optval(rel_tol, 1.0e-9_${k1}$)*max(abs(a), abs(b))), &
+            close = abs(a - b) <= max( abs(optval(rel_tol, sqrt_eps_${k1}$)*max(abs(a), abs(b))), &
                                        abs(optval(abs_tol, 0.0_${k1}$)) )
         end if     
 
diff --git a/src/tests/math/test_stdlib_math.fypp b/src/tests/math/test_stdlib_math.fypp
@@ -4,7 +4,7 @@
 
 module test_stdlib_math
     use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
-    use stdlib_math, only: clip
+    use stdlib_math, only: clip, is_close, all_close
     use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
     implicit none
 
@@ -32,6 +32,14 @@ contains
             new_unittest("clip-real-double-bounds", test_clip_rdp_bounds), &
             new_unittest("clip-real-quad", test_clip_rqp), &
             new_unittest("clip-real-quad-bounds", test_clip_rqp_bounds) &
+            
+            !> Tests for `is_close` and `all_close`
+            #:for k1 in REAL_KINDS
+            , new_unittest("is_close-real-${k1}$", test_is_close_real_${k1}$) &
+            , new_unittest("is_close-cmplx-${k1}$", test_is_close_cmplx_${k1}$) &
+            , new_unittest("all_close-real-${k1}$", test_all_close_real_${k1}$) &
+            , new_unittest("all_close-cmplx-${k1}$", test_all_close_cmplx_${k1}$) &
+            #:endfor
             ]
 
     end subroutine collect_stdlib_math
@@ -203,6 +211,89 @@ contains
 #:endif
 
     end subroutine test_clip_rqp_bounds
+    
+    #:for k1 in REAL_KINDS
+    subroutine test_is_close_real_${k1}$(error)
+        type(error_type), allocatable, intent(out) :: error
+        real(${k1}$) :: x, NAN
+        x = -3; NAN = sqrt(x)
+        
+        call check(error, is_close(2.5_${k1}$, 2.5_${k1}$), .true.)
+        if (allocated(error)) return
+        call check(error, is_close(0.0_${k1}$, -0.0_${k1}$), .true.)
+        if (allocated(error)) return
+        call check(error, is_close(2.5_${k1}$, 1.2_${k1}$), .false.)
+        if (allocated(error)) return
+        call check(error, is_close(NAN, NAN), .false.)
+        if (allocated(error)) return
+        call check(error, is_close(NAN, 0.0_${k1}$), .false.)
+        if (allocated(error)) return
+        call check(error, is_close(NAN, NAN, equal_nan=.true.), .true.)
+    
+    end subroutine test_is_close_real_${k1}$
+    
+    subroutine test_is_close_cmplx_${k1}$(error)
+        type(error_type), allocatable, intent(out) :: error
+        real(${k1}$) :: x, NAN
+        x = -3; NAN = sqrt(x)
+        
+        call check(error, is_close((2.5_${k1}$, 1.5_${k1}$), (2.5_${k1}$, 1.5_${k1}$)), .true.)
+        if (allocated(error)) return
+        call check(error, is_close((2.5_${k1}$, 1.2_${k1}$), (2.5_${k1}$, 1.5_${k1}$)), .false.)
+        if (allocated(error)) return
+        call check(error, is_close(cmplx(NAN, NAN, ${k1}$), cmplx(NAN, NAN, ${k1}$)), .false.)
+        if (allocated(error)) return
+        call check(error, is_close(cmplx(NAN, NAN, ${k1}$), cmplx(NAN, 0.0_${k1}$, ${k1}$)), .false.)
+        if (allocated(error)) return
+        call check(error, is_close(cmplx(NAN, NAN, ${k1}$), cmplx(NAN, NAN, ${k1}$), equal_nan=.true.), .true.)
+        if (allocated(error)) return
+        call check(error, is_close(cmplx(NAN, 1.2_${k1}$, ${k1}$), cmplx(NAN, 1.2_${k1}$, ${k1}$), equal_nan=.true.), .true.)
+        
+    end subroutine test_is_close_cmplx_${k1}$
+    
+    subroutine test_all_close_real_${k1}$(error)
+        type(error_type), allocatable, intent(out) :: error
+        real(${k1}$) :: x(2, 2), eps, NAN
+        x = 1; eps = -3; NAN = sqrt(eps)
+        
+        eps = sqrt(epsilon(1.0_${k1}$))
+        
+        call check(error, all_close(x, x), .true.)
+        if (allocated(error)) return
+        call check(error, all_close(x + x*eps + 1.0e-6, x), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + NAN, x), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + NAN, x, equal_nan=.true.), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + NAN, x + NAN), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + NAN, x + NAN, equal_nan=.true.), .true.)
+        
+    end subroutine test_all_close_real_${k1}$
+    
+    subroutine test_all_close_cmplx_${k1}$(error)
+        type(error_type), allocatable, intent(out) :: error
+        real(${k1}$) :: eps, NAN
+        complex(${k1}$) :: x(2, 2)
+        x = (1, 1); eps = -3; NAN = sqrt(eps)
+        
+        eps = sqrt(epsilon(1.0_${k1}$))
+        
+        call check(error, all_close(x, x), .true.)
+        if (allocated(error)) return
+        call check(error, all_close(x + x*eps + 1.0e-6, x), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x, equal_nan=.true.), .false.)
+        if (allocated(error)) return
+        call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x + cmplx(NAN, NAN, ${k1}$), equal_nan=.true.), .true.)
+        if (allocated(error)) return
+        call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x + cmplx(NAN, NAN, ${k1}$)), .false.)
+        
+    end subroutine test_all_close_cmplx_${k1}$
+    #:endfor
 
 end module test_stdlib_math
 
