From 6adbeb5dcaca9d22c8ba01706ba005686efb9062 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 5 Feb 2022 10:59:39 +0800 Subject: [PATCH 1/2] Moved arange's unit tests to test_stdlib_math; And improved some stuff in stdlib_math.md. --- CHANGELOG.md | 3 + doc/specs/stdlib_math.md | 91 +++++++++++++------------- src/stdlib_math.fypp | 23 +++---- src/tests/math/CMakeLists.txt | 1 - src/tests/math/Makefile.manual | 1 - src/tests/math/test_math_arange.f90 | 86 ------------------------- src/tests/math/test_stdlib_math.fypp | 95 +++++++++++++++++++++++++++- 7 files changed, 155 insertions(+), 145 deletions(-) delete mode 100644 src/tests/math/test_math_arange.f90 diff --git a/CHANGELOG.md b/CHANGELOG.md index 8c996524d..b8da83fb3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -52,6 +52,9 @@ Changes to existing modules - change in module `stdlib_io` - Modified format constants, and made public [#617](https://github.com/fortran-lang/stdlib/pull/617) +- change in module `stdlib_math` + - Minor update to `stdlib_math` module and document + [#624](https://github.com/fortran-lang/stdlib/pull/624) # Version 0.1.0 diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 2640d3ed0..9091b836d 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -320,7 +320,7 @@ program demo_logspace_rstart_cbase end program demo_logspace_rstart_cbase ``` -### `arange` +### `arange` function #### Status @@ -332,7 +332,7 @@ Pure function. #### Description -Creates a one-dimensional `array` of the `integer/real` type with fixed-spaced values of given spacing, within a given interval. +Creates a rank-1 `array` of the `integer/real` type with fixed-spaced values of given spacing, within a given interval. #### Syntax @@ -360,7 +360,7 @@ If `step < 0`, the `step` argument will be corrected to `abs(step)` by the inter #### Return value -Returns a one-dimensional `array` of fixed-spaced values. +Returns a rank-1 `array` of fixed-spaced values. For `integer` type arguments, the length of the result vector is `(end - start)/step + 1`. For `real` type arguments, the length of the result vector is `floor((end - start)/step) + 1`. @@ -371,25 +371,25 @@ For `real` type arguments, the length of the result vector is `floor((end - star program demo_math_arange use stdlib_math, only: arange - print *, arange(3) !! [1,2,3] - print *, arange(-1) !! [1,0,-1] - print *, arange(0,2) !! [0,1,2] - print *, arange(1,-1) !! [1,0,-1] - print *, arange(0, 2, 2) !! [0,2] + print *, arange(3) ! [1,2,3] + print *, arange(-1) ! [1,0,-1] + print *, arange(0,2) ! [0,1,2] + print *, arange(1,-1) ! [1,0,-1] + print *, arange(0, 2, 2) ! [0,2] - print *, arange(3.0) !! [1.0,2.0,3.0] - print *, arange(0.0,5.0) !! [0.0,1.0,2.0,3.0,4.0,5.0] - print *, arange(0.0,6.0,2.5) !! [0.0,2.5,5.0] + print *, arange(3.0) ! [1.0,2.0,3.0] + print *, arange(0.0,5.0) ! [0.0,1.0,2.0,3.0,4.0,5.0] + print *, arange(0.0,6.0,2.5) ! [0.0,2.5,5.0] - print *, (1.0,1.0)*arange(3) !! [(1.0,1.0),(2.0,2.0),[3.0,3.0]] + print *, (1.0,1.0)*arange(3) ! [(1.0,1.0),(2.0,2.0),[3.0,3.0]] - print *, arange(0.0,2.0,-2.0) !! [0.0,2.0]. Not recommended: `step` argument is negative! - print *, arange(0.0,2.0,0.0) !! [0.0,1.0,2.0]. Not recommended: `step` argument is zero! + print *, arange(0.0,2.0,-2.0) ! [0.0,2.0]. Not recommended: `step` argument is negative! + print *, arange(0.0,2.0,0.0) ! [0.0,1.0,2.0]. Not recommended: `step` argument is zero! end program demo_math_arange ``` -### `arg` - Computes the phase angle in radian of a complex scalar +### `arg` function #### Status @@ -424,13 +424,14 @@ Notes: Although the angle of the complex number `0` is undefined, `arg((0,0))` r ```fortran program demo_math_arg use stdlib_math, only: arg - print *, arg((0.0, 0.0)) !! 0.0 - print *, arg((3.0, 4.0)) !! 0.927 - print *, arg(2.0*exp((0.0, 0.5))) !! 0.5 + print *, arg((0.0, 0.0)) ! 0.0 + print *, arg((3.0, 4.0)) ! 0.927 + print *, arg(2.0*exp((0.0, 0.5))) ! 0.5 + print *, arg([(0.0, 1.0), (1.0, 0.0), (0.0, -1.0), (-1.0, 0.0)]) ! [π/2, 0.0, -π/2, π] end program demo_math_arg ``` -### `argd` - Computes the phase angle in degree of a complex scalar +### `argd` function #### Status @@ -465,13 +466,14 @@ Notes: Although the angle of the complex number `0` is undefined, `argd((0,0))` ```fortran program demo_math_argd use stdlib_math, only: argd - print *, argd((0.0, 0.0)) !! 0.0 - print *, argd((3.0, 4.0)) !! 53.1° - print *, argd(2.0*exp((0.0, 0.5))) !! 28.64° + print *, argd((0.0, 0.0)) ! 0.0° + print *, argd((3.0, 4.0)) ! 53.1° + print *, argd(2.0*exp((0.0, 0.5))) ! 28.64° + print *, argd([(0.0, 1.0), (1.0, 0.0), (0.0, -1.0), (-1.0, 0.0)]) ! [90°, 0°, -90°, 180°] end program demo_math_argd ``` -### `argpi` - Computes the phase angle in circular of a complex scalar +### `argpi` function #### Status @@ -506,13 +508,14 @@ Notes: Although the angle of the complex number `0` is undefined, `argpi((0,0))` ```fortran program demo_math_argpi use stdlib_math, only: argpi - print *, argpi((0.0, 0.0)) !! 0.0 - print *, argpi((3.0, 4.0)) !! 0.295 - print *, argpi(2.0*exp((0.0, 0.5))) !! 0.159 + print *, argpi((0.0, 0.0)) ! 0.0 + print *, argpi((3.0, 4.0)) ! 0.295 + print *, argpi(2.0*exp((0.0, 0.5))) ! 0.159 + print *, argpi([(0.0, 1.0), (1.0, 0.0), (0.0, -1.0), (-1.0, 0.0)]) ! [0.5, 0.0, -0.5, 1.0] end program demo_math_argpi ``` -### `is_close` +### `is_close` function #### Description @@ -577,15 +580,15 @@ program demo_math_is_close y = -3 NAN = sqrt(y) - print *, is_close(x,[real :: 1, 2.1]) !! [T, F] - 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 + print *, is_close(x,[real :: 1, 2.1]) ! [T, F] + 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 end program demo_math_is_close ``` -### `all_close` +### `all_close` function #### Description @@ -643,14 +646,14 @@ program demo_math_all_close NAN = sqrt(y) z = (1.0, 1.0) - print *, all_close(z+cmplx(1.0e-11, 1.0e-11), z) !! T + 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 + ! NAN, F, T end program demo_math_all_close ``` -### `diff` +### `diff` function #### Description @@ -658,14 +661,11 @@ Computes differences between adjacent elements of an array. #### Syntax -For a rank-1 array -```fortran -y = [[stdlib_math(module):diff(interface)]](x [, n, prepend, append]) -``` -and for a rank-2 array -```fortran -y = [[stdlib_math(module):diff(interface)]](x [, n, dim, prepend, append]) -``` +For a rank-1 array: +`y = [[stdlib_math(module):diff(interface)]](x [, n, prepend, append])` + +and for a rank-2 array: +`y = [[stdlib_math(module):diff(interface)]](x [, n, dim, prepend, append])` #### Status @@ -696,8 +696,9 @@ Shall be a `real/integer` and `rank-1/rank-2` array. This argument is `intent(in)` and `optional`, which is no value by default. Note: -- The `x`, `prepend` and `append` arguments must have the same `type`, `kind` and `rank`. -- If the value of `n` is less than or equal to `0` (which is not recommended), the return value of `diff` is `x`. + +- The `x`, `prepend` and `append` arguments must have the same `type`, `kind` and `rank`. +- If the value of `n` is less than or equal to `0` (which is not recommended), the return value of `diff` is `x`. - If the value of `dim` is not equal to `1` or `2` (which is not recommended), `1` will be used by the internal process of `diff`. diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 3ffda8afd..c75b4d9f5 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -287,7 +287,7 @@ module stdlib_math !> !> `arange` creates a one-dimensional `array` of the `integer/real` type !> with fixed-spaced values of given spacing, within a given interval. - !> ([Specification](../page/specs/stdlib_math.html#arange)) + !> ([Specification](../page/specs/stdlib_math.html#arange-function)) interface arange #:set RI_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES #:for k1, t1 in RI_KINDS_TYPES @@ -302,7 +302,7 @@ module stdlib_math !> Version: experimental !> !> `arg` computes the phase angle in the interval (-π,π]. - !> ([Specification](../page/specs/stdlib_math.html#arg)) + !> ([Specification](../page/specs/stdlib_math.html#arg-function)) interface arg #:for k1 in CMPLX_KINDS procedure :: arg_${k1}$ @@ -312,7 +312,7 @@ module stdlib_math !> Version: experimental !> !> `argd` computes the phase angle of degree version in the interval (-180.0,180.0]. - !> ([Specification](../page/specs/stdlib_math.html#argd)) + !> ([Specification](../page/specs/stdlib_math.html#argd-function)) interface argd #:for k1 in CMPLX_KINDS procedure :: argd_${k1}$ @@ -322,7 +322,7 @@ module stdlib_math !> Version: experimental !> !> `argpi` computes the phase angle of circular version in the interval (-1.0,1.0]. - !> ([Specification](../page/specs/stdlib_math.html#argpi)) + !> ([Specification](../page/specs/stdlib_math.html#argpi-function)) interface argpi #:for k1 in CMPLX_KINDS procedure :: argpi_${k1}$ @@ -330,7 +330,7 @@ module stdlib_math end interface argpi !> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance. - !> ([Specification](../page/specs/stdlib_math.html#is_close)) + !> ([Specification](../page/specs/stdlib_math.html#is_close-function)) interface is_close #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES #:for k1, t1 in RC_KINDS_TYPES @@ -345,7 +345,7 @@ module stdlib_math !> Version: experimental !> !> Returns a boolean scalar where two arrays are element-wise equal within a tolerance. - !> ([Specification](../page/specs/stdlib_math.html#all_close)) + !> ([Specification](../page/specs/stdlib_math.html#all_close-function)) interface all_close #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES #:set RANKS = range(1, MAXRANK + 1) @@ -363,7 +363,7 @@ module stdlib_math !> Version: experimental !> !> Computes differences between adjacent elements of an array. - !> ([Specification](../page/specs/stdlib_math.html#diff)) + !> ([Specification](../page/specs/stdlib_math.html#diff-function)) interface diff #:set RI_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES #:for k1, t1 in RI_KINDS_TYPES @@ -409,8 +409,8 @@ contains ${t1}$, intent(in) :: z real(${k1}$) :: result - result = merge(0.0_${k1}$, atan2(z%im, z%re), z == (0.0_${k1}$, 0.0_${k1}$)) & - *180.0_${k1}$/PI_${k1}$ + result = merge(0.0_${k1}$, atan2(z%im, z%re)*180.0_${k1}$/PI_${k1}$, & + z == (0.0_${k1}$, 0.0_${k1}$)) end function argd_${k1}$ @@ -418,8 +418,9 @@ contains ${t1}$, intent(in) :: z real(${k1}$) :: result - result = merge(0.0_${k1}$, atan2(z%im, z%re), z == (0.0_${k1}$, 0.0_${k1}$)) & - /PI_${k1}$ + result = merge(0.0_${k1}$, atan2(z%im, z%re)/PI_${k1}$, & + z == (0.0_${k1}$, 0.0_${k1}$)) + end function argpi_${k1}$ #:endfor diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index 9d11bf765..9f9683516 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -7,4 +7,3 @@ fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) ADDTEST(stdlib_math) ADDTEST(linspace) ADDTEST(logspace) -ADDTEST(math_arange) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index 5da73c5da..19d7a64a9 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -3,7 +3,6 @@ SRCFYPP = \ SRCGEN = $(SRCFYPP:.fypp=.f90) PROGS_SRC = test_linspace.f90 test_logspace.f90 \ - test_math_arange.f90 \ $(SRCGEN) $(SRCGEN): %.f90: %.fypp ../../common.fypp diff --git a/src/tests/math/test_math_arange.f90 b/src/tests/math/test_math_arange.f90 deleted file mode 100644 index 71d67b5ee..000000000 --- a/src/tests/math/test_math_arange.f90 +++ /dev/null @@ -1,86 +0,0 @@ -! SPDX-Identifier: MIT - -module test_math_arange - use testdrive, only : new_unittest, unittest_type, error_type, check - use stdlib_math, only: arange - implicit none - - public :: collect_math_arange - -contains - - !> Collect all exported unit tests - subroutine collect_math_arange(testsuite) - !> Collection of tests - type(unittest_type), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - new_unittest("arange-real", test_math_arange_real), & - new_unittest("arange-integer", test_math_arange_integer) & - ] - - end subroutine collect_math_arange - - subroutine test_math_arange_real(error) - !> Error handling - type(error_type), allocatable, intent(out) :: error - - ! Normal - call check(error, all(arange(3.0) == [1.0, 2.0, 3.0]), "all(arange(3.0) == [1.0,2.0,3.0]) failed.") - call check(error, all(arange(-1.0) == [1.0, 0.0, -1.0]), "all(arange(-1.0) == [1.0,0.0,-1.0]) failed.") - call check(error, all(arange(0.0, 2.0) == [0.0, 1.0, 2.0]), "all(arange(0.0,2.0) == [0.0,1.0,2.0]) failed.") - call check(error, all(arange(1.0, -1.0) == [1.0, 0.0, -1.0]), "all(arange(1.0,-1.0) == [1.0,0.0,-1.0]) failed.") - call check(error, all(arange(1.0, 1.0) == [1.0]), "all(arange(1.0,1.0) == [1.0]) failed.") - call check(error, all(arange(0.0, 2.0, 2.0) == [0.0, 2.0]), "all(arange(0.0,2.0,2.0) == [0.0,2.0]) failed.") - call check(error, all(arange(1.0, -1.0, 2.0) == [1.0, -1.0]), "all(arange(1.0,-1.0,2.0) == [1.0,-1.0]) failed.") - ! Not recommended - call check(error, all(arange(0.0, 2.0, -2.0) == [0.0, 2.0]), "all(arange(0.0,2.0,-2.0) == [0.0,2.0]) failed.") - call check(error, all(arange(1.0, -1.0, -2.0) == [1.0, -1.0]),"all(arange(1.0,-1.0,-2.0) == [1.0,-1.0]) failed.") - call check(error, all(arange(0.0, 2.0, 0.0) == [0.0,1.0,2.0]),"all(arange(0.0, 2.0, 0.0) == [0.0,1.0,2.0]) failed.") - end subroutine test_math_arange_real - - subroutine test_math_arange_integer(error) - !> Error handling - type(error_type), allocatable, intent(out) :: error - - ! Normal - call check(error, all(arange(3) == [1, 2, 3]), "all(arange(3) == [1,2,3]) failed.") - call check(error, all(arange(-1) == [1, 0, -1]), "all(arange(-1) == [1,0,-1]) failed.") - call check(error, all(arange(0, 2) == [0, 1, 2]), "all(arange(0,2) == [0,1,2]) failed.") - call check(error, all(arange(1, -1) == [1, 0, -1]), "all(arange(1,-1) == [1,0,-1]) failed.") - call check(error, all(arange(1, 1) == [1]), "all(arange(1,1) == [1]) failed.") - call check(error, all(arange(0, 2, 2) == [0, 2]), "all(arange(0,2,2) == [0,2]) failed.") - call check(error, all(arange(1, -1, 2) == [1, -1]), "all(arange(1,-1,2) == [1,-1]) failed.") - ! Not recommended - call check(error, all(arange(0, 2, -2) == [0, 2]), "all(arange(0,2,-2) == [0,2]) failed.") - call check(error, all(arange(1, -1, -2) == [1, -1]), "all(arange(1,-1,-2) == [1,-1]) failed.") - call check(error, all(arange(0, 2, 0) == [0,1,2]), "all(arange(0, 2, 0) == [0,1,2]) failed.") - end subroutine test_math_arange_integer - -end module test_math_arange - -program tester - use, intrinsic :: iso_fortran_env, only : error_unit - use testdrive, only : run_testsuite, new_testsuite, testsuite_type - use test_math_arange, only : collect_math_arange - implicit none - integer :: stat, is - type(testsuite_type), allocatable :: testsuites(:) - character(len=*), parameter :: fmt = '("#", *(1x, a))' - - stat = 0 - - testsuites = [ & - new_testsuite("math-arange", collect_math_arange) & - ] - - do is = 1, size(testsuites) - write(error_unit, fmt) "Testing:", testsuites(is)%name - call run_testsuite(testsuites(is)%collect, error_unit, stat) - end do - - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" - error stop - end if -end program tester diff --git a/src/tests/math/test_stdlib_math.fypp b/src/tests/math/test_stdlib_math.fypp index bf061057b..9b02f5fbe 100644 --- a/src/tests/math/test_stdlib_math.fypp +++ b/src/tests/math/test_stdlib_math.fypp @@ -4,7 +4,8 @@ module test_stdlib_math use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_math, only: clip, arg, argd, argpi, arange, is_close, all_close, diff + use stdlib_math, only: clip, arg, argd, argpi, arange, is_close, all_close, diff, & + arange use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp implicit none @@ -59,6 +60,14 @@ contains #:for k1 in INT_KINDS , new_unittest("diff-int-${k1}$", test_diff_int_${k1}$) & #:endfor + + !> Tests for `arange` + #:for k1 in REAL_KINDS + , new_unittest("arange-real-${k1}$", test_arange_real_${k1}$) & + #:endfor + #:for k1 in INT_KINDS + , new_unittest("arange-int-${k1}$", test_arange_int_${k1}$) & + #:endfor ] end subroutine collect_stdlib_math @@ -243,6 +252,7 @@ contains if (allocated(error)) return call check(error, abs(arg((0.0_${k1}$, 0.0_${k1}$)) - 0.0_${k1}$) < tol, & "test_zero_scalar") + if (allocated(error)) return #! and for array (180.0° see scalar version) theta = arange(-179.0_${k1}$, 179.0_${k1}$, 3.58_${k1}$) @@ -262,6 +272,7 @@ contains if (allocated(error)) return call check(error, abs(argd((0.0_${k1}$, 0.0_${k1}$)) - 0.0_${k1}$) < tol, & "test_zero_scalar") + if (allocated(error)) return #! and for array (180.0° see scalar version) theta = arange(-179.0_${k1}$, 179.0_${k1}$, 3.58_${k1}$) @@ -281,6 +292,7 @@ contains if (allocated(error)) return call check(error, abs(argpi((0.0_${k1}$, 0.0_${k1}$)) - 0.0_${k1}$) < tol, & "test_zero_scalar") + if (allocated(error)) return #! and for array (180.0° see scalar version) theta = arange(-179.0_${k1}$, 179.0_${k1}$, 3.58_${k1}$) @@ -386,6 +398,7 @@ contains if (allocated(error)) return call check(error, all_close(diff(x, n=0), x), & "diff(, n=0) in test_diff_real_${k1}$ failed") + if (allocated(error)) return call check(error, all_close(diff(x, n=2), [${t1}$ :: 5, 5, 5, 5]), & "diff(, n=2) in test_diff_real_${k1}$ failed") if (allocated(error)) return @@ -465,6 +478,86 @@ contains end subroutine test_diff_int_${k1}$ #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + subroutine test_arange_real_${k1}$(error) + type(error_type), allocatable, intent(out) :: error + + ! Normal + call check(error, all_close(arange(3.0_${k1}$), [1.0_${k1}$, 2.0_${k1}$, 3.0_${k1}$]), & + "all(arange(3.0_${k1}$), [1.0_${k1}$,2.0_${k1}$,3.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(-1.0_${k1}$), [1.0_${k1}$, 0.0_${k1}$, -1.0_${k1}$]), & + "all_close(arange(-1.0_${k1}$), [1.0_${k1}$,0.0_${k1}$,-1.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(0.0_${k1}$, 2.0_${k1}$), [0.0_${k1}$, 1.0_${k1}$, 2.0_${k1}$]), & + "all_close(arange(0.0_${k1}$,2.0_${k1}$), [0.0_${k1}$,1.0_${k1}$,2.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(1.0_${k1}$, -1.0_${k1}$), [1.0_${k1}$, 0.0_${k1}$, -1.0_${k1}$]), & + "all_close(arange(1.0_${k1}$,-1.0_${k1}$), [1.0_${k1}$,0.0_${k1}$,-1.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(1.0_${k1}$, 1.0_${k1}$), [1.0_${k1}$]), & + "all_close(arange(1.0_${k1}$,1.0_${k1}$), [1.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(0.0_${k1}$, 2.0_${k1}$, 2.0_${k1}$), [0.0_${k1}$, 2.0_${k1}$]), & + "all_close(arange(0.0_${k1}$,2.0_${k1}$,2.0_${k1}$), [0.0_${k1}$,2.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(1.0_${k1}$, -1.0_${k1}$, 2.0_${k1}$), [1.0_${k1}$, -1.0_${k1}$]), & + "all_close(arange(1.0_${k1}$,-1.0_${k1}$,2.0_${k1}$), [1.0_${k1}$,-1.0_${k1}$]) failed.") + if (allocated(error)) return + + ! Not recommended + call check(error, all_close(arange(0.0_${k1}$, 2.0_${k1}$, -2.0_${k1}$), [0.0_${k1}$, 2.0_${k1}$]), & + "all_close(arange(0.0_${k1}$,2.0_${k1}$,-2.0_${k1}$), [0.0_${k1}$,2.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(1.0_${k1}$, -1.0_${k1}$, -2.0_${k1}$), [1.0_${k1}$, -1.0_${k1}$]), & + "all_close(arange(1.0_${k1}$,-1.0_${k1}$,-2.0_${k1}$), [1.0_${k1}$,-1.0_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all_close(arange(0.0_${k1}$, 2.0_${k1}$, 0.0_${k1}$), [0.0_${k1}$,1.0_${k1}$,2.0_${k1}$]), & + "all_close(arange(0.0_${k1}$, 2.0_${k1}$, 0.0_${k1}$), [0.0_${k1}$,1.0_${k1}$,2.0_${k1}$]) failed.") + end subroutine test_arange_real_${k1}$ + #:endfor + + #:for k1, t1 in INT_KINDS_TYPES + subroutine test_arange_int_${k1}$(error) + type(error_type), allocatable, intent(out) :: error + + ! Normal + call check(error, all(arange(3_${k1}$) == [1_${k1}$, 2_${k1}$, 3_${k1}$]), & + "all(arange(3_${k1}$) == [1_${k1}$,2_${k1}$,3_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(-1_${k1}$) == [1_${k1}$, 0_${k1}$, -1_${k1}$]), & + "all(arange(-1_${k1}$) == [1_${k1}$,0_${k1}$,-1_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(0_${k1}$, 2_${k1}$) == [0_${k1}$, 1_${k1}$, 2_${k1}$]), & + "all(arange(0_${k1}$,2_${k1}$) == [0_${k1}$,1_${k1}$,2_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(1_${k1}$, -1_${k1}$) == [1_${k1}$, 0_${k1}$, -1_${k1}$]), & + "all(arange(1_${k1}$,-1_${k1}$) == [1_${k1}$,0_${k1}$,-1_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(1_${k1}$, 1_${k1}$) == [1_${k1}$]), & + "all(arange(1_${k1}$,1_${k1}$) == [1_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(0_${k1}$, 2_${k1}$, 2_${k1}$) == [0_${k1}$, 2_${k1}$]), & + "all(arange(0_${k1}$,2_${k1}$,2_${k1}$) == [0_${k1}$,2_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(1_${k1}$, -1_${k1}$, 2_${k1}$) == [1_${k1}$, -1_${k1}$]), & + "all(arange(1_${k1}$,-1_${k1}$,2_${k1}$) == [1_${k1}$,-1_${k1}$]) failed.") + if (allocated(error)) return + + ! Not recommended + call check(error, all(arange(0_${k1}$, 2_${k1}$, -2_${k1}$) == [0_${k1}$, 2_${k1}$]), & + "all(arange(0_${k1}$,2_${k1}$,2_${k1}$) == [0_${k1}$,2_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(1_${k1}$, -1_${k1}$, -2_${k1}$) == [1_${k1}$, -1_${k1}$]), & + "all(arange(1_${k1}$,-1_${k1}$,2_${k1}$) == [1_${k1}$,-1_${k1}$]) failed.") + if (allocated(error)) return + call check(error, all(arange(0_${k1}$, 2_${k1}$, 0_${k1}$) == [0_${k1}$, 1_${k1}$, 2_${k1}$]), & + "all(arange(0_${k1}$,2_${k1}$,0_${k1}$) == [0_${k1}$,1_${k1}$,2_${k1}$]) failed.") + + end subroutine test_arange_int_${k1}$ + #:endfor + end module test_stdlib_math From 4ef8650496f101a434739425c6677acdf11c16be Mon Sep 17 00:00:00 2001 From: zoziha Date: Mon, 14 Feb 2022 10:05:51 +0800 Subject: [PATCH 2/2] FORD failed, temporarily add `include`. --- API-doc-FORD-file.md | 1 + 1 file changed, 1 insertion(+) diff --git a/API-doc-FORD-file.md b/API-doc-FORD-file.md index 5240093ae..0db3e0a21 100644 --- a/API-doc-FORD-file.md +++ b/API-doc-FORD-file.md @@ -2,6 +2,7 @@ project: Fortran-lang/stdlib summary: A community driven standard library for (modern) Fortran src_dir: src +include: src exclude_dir: src/tests output_dir: API-doc page_dir: doc