From 2608434dd88aa3a06e899af0347f0efe7bfb657a Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Tue, 23 Mar 2021 19:45:01 +0530 Subject: [PATCH 01/16] implemented generic clip function --- src/CMakeLists.txt | 1 + src/Makefile.manual | 1 + src/stdlib_math.fypp | 33 +++++++++++++++++++++++++++++++++ 3 files changed, 35 insertions(+) create mode 100644 src/stdlib_math.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 85f5c68b6..cc04cbd6a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -22,6 +22,7 @@ set(fppFiles stdlib_quadrature_trapz.fypp stdlib_quadrature_simps.fypp stdlib_stats_distribution_PRNG.fypp + stdlib_math.fypp ) diff --git a/src/Makefile.manual b/src/Makefile.manual index 804b04272..aa461dfb6 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -18,6 +18,7 @@ SRCFYPP =\ stdlib_stats_moment_mask.fypp \ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ + stdlib_math.fypp \ stdlib_stats_distribution_PRNG.fypp SRC = f18estop.f90 \ diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp new file mode 100644 index 000000000..c8c1a4c80 --- /dev/null +++ b/src/stdlib_math.fypp @@ -0,0 +1,33 @@ +#:include "common.fypp" + +#:set INT_KINDS_TYPES = [("int8", "integer"), ("int16", "integer"), ("int32", "integer"), ("int64", "integer")] +#:set REAL_KINDS_TYPES = [("sp", "real"), ("dp", "real"), ("qp", "real")] + +#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES +module stdlib_math + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp + + implicit none + private + public :: clip + + + interface clip + #:for k1, t1 in IR_KINDS_TYPES + module procedure clip_${t1}$_${k1}$ + #:endfor + end interface clip + + + contains + #:for k1, t1 in IR_KINDS_TYPES + elemental function clip_${t1}$_${k1}$(x, xmin, xmax) result(res) + ${t1}$(${k1}$), intent(in) :: x + ${t1}$(${k1}$), intent(in) :: xmin + ${t1}$(${k1}$), intent(in) :: xmax + ${t1}$(${k1}$) :: res + res = max(min(x, xmax), xmin) + end function clip_${t1}$_${k1}$ + #:endfor + +end module stdlib_math From 5d108dee9b2ca6138cb87629a98a79a32367f1af Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 26 Mar 2021 12:01:49 +0530 Subject: [PATCH 02/16] addedunit test for clip function; added math subdirectory in CMakeLists.txt and Makefile.manual of tests directory --- src/stdlib_math.fypp | 4 +- src/tests/CMakeLists.txt | 1 + src/tests/Makefile.manual | 3 + src/tests/math/CMakeLists.txt | 1 + src/tests/math/Makefile.manual | 4 + src/tests/math/test_math.f90 | 357 +++++++++++++++++++++++++++++++++ src/tests/math/test_math.fypp | 80 ++++++++ 7 files changed, 449 insertions(+), 1 deletion(-) create mode 100644 src/tests/math/CMakeLists.txt create mode 100644 src/tests/math/Makefile.manual create mode 100644 src/tests/math/test_math.f90 create mode 100644 src/tests/math/test_math.fypp diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index c8c1a4c80..29e647486 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -2,8 +2,8 @@ #:set INT_KINDS_TYPES = [("int8", "integer"), ("int16", "integer"), ("int32", "integer"), ("int64", "integer")] #:set REAL_KINDS_TYPES = [("sp", "real"), ("dp", "real"), ("qp", "real")] - #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + module stdlib_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp @@ -20,6 +20,7 @@ module stdlib_math contains + #:for k1, t1 in IR_KINDS_TYPES elemental function clip_${t1}$_${k1}$(x, xmin, xmax) result(res) ${t1}$(${k1}$), intent(in) :: x @@ -28,6 +29,7 @@ module stdlib_math ${t1}$(${k1}$) :: res res = max(min(x, xmax), xmin) end function clip_${t1}$_${k1}$ + #:endfor end module stdlib_math diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 288445de9..71275e021 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -16,6 +16,7 @@ add_subdirectory(stats) add_subdirectory(string) add_subdirectory(system) add_subdirectory(quadrature) +add_subdirectory(math) ADDTEST(always_skip) set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index 553a69bed..fe5a0b7c8 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -9,6 +9,7 @@ all: $(MAKE) -f Makefile.manual --directory=quadrature $(MAKE) -f Makefile.manual --directory=stats $(MAKE) -f Makefile.manual --directory=string + $(MAKE) -f Makefile.manual --directory=math test: $(MAKE) -f Makefile.manual --directory=ascii test @@ -19,6 +20,7 @@ test: $(MAKE) -f Makefile.manual --directory=quadrature test $(MAKE) -f Makefile.manual --directory=stats test $(MAKE) -f Makefile.manual --directory=string test + $(MAKE) -f Makefile.manual --directory=math test clean: $(MAKE) -f Makefile.manual --directory=ascii clean @@ -28,3 +30,4 @@ clean: $(MAKE) -f Makefile.manual --directory=optval clean $(MAKE) -f Makefile.manual --directory=stats clean $(MAKE) -f Makefile.manual --directory=string clean + $(MAKE) -f Makefile.manual --directory=math clean diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt new file mode 100644 index 000000000..963baf78a --- /dev/null +++ b/src/tests/math/CMakeLists.txt @@ -0,0 +1 @@ +ADDTEST(math) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual new file mode 100644 index 000000000..1ec3f5b3f --- /dev/null +++ b/src/tests/math/Makefile.manual @@ -0,0 +1,4 @@ +PROGS_SRC = test_math.f90 + + +include ../Makefile.manual.test.mk diff --git a/src/tests/math/test_math.f90 b/src/tests/math/test_math.f90 new file mode 100644 index 000000000..f6afc10b8 --- /dev/null +++ b/src/tests/math/test_math.f90 @@ -0,0 +1,357 @@ +! SPDX-Identifier: MIT + + +module test_math + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp + use stdlib_error, only : check + use stdlib_math + + implicit none + + contains + subroutine test_clip_integer_int8(x, xmin, xmax, compare) + integer(int8), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_integer_int8 + + subroutine test_clip_integer_int16(x, xmin, xmax, compare) + integer(int16), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_integer_int16 + + subroutine test_clip_integer_int32(x, xmin, xmax, compare) + integer(int32), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_integer_int32 + + subroutine test_clip_integer_int64(x, xmin, xmax, compare) + integer(int64), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_integer_int64 + + subroutine test_clip_real_sp(x, xmin, xmax, compare) + real(sp), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_real_sp + + subroutine test_clip_real_dp(x, xmin, xmax, compare) + real(dp), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_real_dp + + subroutine test_clip_real_qp(x, xmin, xmax, compare) + real(qp), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_real_qp + + +end module test_math + + +program tester + use test_math + implicit none + + ! test case format: (x, xmin, xmax, correct answer) + ! valid case: xmin is not greater than xmax + ! invalid case: xmin is greater than xmax + + + ! data declaration + integer(int8) :: x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8 + integer(int16) :: x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16 + integer(int32) :: x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32 + integer(int64) :: x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64 + real(sp) :: x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp + real(dp) :: x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp + real(qp) :: x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp + + ! type: integer, kind: int8 + ! valid test cases + x_integer_int8 = 2 + xmin_integer_int8 = -2 + xmax_integer_int8 = 5 + compare_integer_int8 = 2 + call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + + x_integer_int8 = 127 + xmin_integer_int8 = -127 + xmax_integer_int8 = 0 + compare_integer_int8 = 0 + call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + + x_integer_int8 = -57 + xmin_integer_int8 = -57 + xmax_integer_int8 = 57 + compare_integer_int8 = -57 + call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + + ! invalid test cases + x_integer_int8 = 2 + xmin_integer_int8 = 5 + xmax_integer_int8 = -2 + compare_integer_int8 = 5 + call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + + x_integer_int8 = 127 + xmin_integer_int8 = 0 + xmax_integer_int8 = -127 + compare_integer_int8 = 0 + call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + + x_integer_int8 = -57 + xmin_integer_int8 = 57 + xmax_integer_int8 = -57 + compare_integer_int8 = 57 + call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + + ! type: integer, kind: int16 + ! valid test cases + x_integer_int16 = 2 + xmin_integer_int16 = -2 + xmax_integer_int16 = 5 + compare_integer_int16 = 2 + call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + + x_integer_int16 = 32767 + xmin_integer_int16 = -32767 + xmax_integer_int16 = 0 + compare_integer_int16 = 0 + call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + + x_integer_int16 = -598 + xmin_integer_int16 = -32 + xmax_integer_int16 = 676 + compare_integer_int16 = -32 + call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + + ! invalid test cases + x_integer_int16 = 2 + xmin_integer_int16 = 5 + xmax_integer_int16 = -2 + compare_integer_int16 = 5 + call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + + x_integer_int16 = 32767 + xmin_integer_int16 = 0 + xmax_integer_int16 = -32767 + compare_integer_int16 = 0 + call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + + x_integer_int16 = -598 + xmin_integer_int16 = 676 + xmax_integer_int16 = -32 + compare_integer_int16 = 676 + call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + + ! type: integer, kind: int32 + ! valid test cases + x_integer_int32 = 2 + xmin_integer_int32 = -2 + xmax_integer_int32 = 5 + compare_integer_int32 = 2 + call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + + x_integer_int32 = -2147483647 + xmin_integer_int32 = 0 + xmax_integer_int32 = 2147483647 + compare_integer_int32 = 0 + call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + + x_integer_int32 = 45732 + xmin_integer_int32 = -385769 + xmax_integer_int32 = 57642 + compare_integer_int32 = 45732 + call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + + ! invalid test cases + x_integer_int32 = 2 + xmin_integer_int32 = 5 + xmax_integer_int32 = -2 + compare_integer_int32 = 5 + call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + + x_integer_int32 = -2147483647 + xmin_integer_int32 = 2147483647 + xmax_integer_int32 = 0 + compare_integer_int32 = 2147483647 + call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + + x_integer_int32 = 45732 + xmin_integer_int32 = 57642 + xmax_integer_int32 = -385769 + compare_integer_int32 = 57642 + call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + + ! type: integer, kind: int64 + ! valid test cases + x_integer_int64 = 2 + xmin_integer_int64 = -2 + xmax_integer_int64 = 5 + compare_integer_int64 = 2 + call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + + x_integer_int64 = -922337203 + xmin_integer_int64 = -10 + xmax_integer_int64 = 25 + compare_integer_int64 = -10 + call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + + x_integer_int64 = 97683 + xmin_integer_int64 = -200 + xmax_integer_int64 = 513788324 + compare_integer_int64 = 97683 + call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + + ! invalid test cases + x_integer_int64 = 2 + xmin_integer_int64 = 5 + xmax_integer_int64 = -2 + compare_integer_int64 = 5 + call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + + x_integer_int64 = -922337203 + xmin_integer_int64 = 25 + xmax_integer_int64 = -10 + compare_integer_int64 = 25 + call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + + x_integer_int64 = 97683 + xmin_integer_int64 = 513788324 + xmax_integer_int64 = -200 + compare_integer_int64 = 513788324 + call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + + ! type: real, kind: sp + ! valid test cases + x_real_sp = 3.025 + xmin_real_sp = -5.77 + xmax_real_sp = 3.025 + compare_real_sp = 3.025 + call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + + x_real_sp = 0.0 + xmin_real_sp = -1578.025 + xmax_real_sp = -59.68 + compare_real_sp = -59.68 + call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + + x_real_sp = 5.6 + xmin_real_sp = -97854.25 + xmax_real_sp = 2.3666 + compare_real_sp = 2.3666 + call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + + ! invalid test cases + x_real_sp = 3.025 + xmin_real_sp = 3.025 + xmax_real_sp = -5.77 + compare_real_sp = 3.025 + call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + + x_real_sp = 0.0 + xmin_real_sp = -59.68 + xmax_real_sp = -1578.025 + compare_real_sp = -59.68 + call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + + x_real_sp = 5.6 + xmin_real_sp = 2.3666 + xmax_real_sp = -97854.25 + compare_real_sp = 2.3666 + call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + + ! type: real, kind: dp + ! valid test cases + x_real_dp = 3.025 + xmin_real_dp = -5.77 + xmax_real_dp = 3.025 + compare_real_dp = 3.025 + call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + + x_real_dp = -7.0 + xmin_real_dp = 0.059668 + xmax_real_dp = 1.00268 + compare_real_dp = 0.059668 + call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + + x_real_dp = -12.3358 + xmin_real_dp = 8.55759 + xmax_real_dp = 8.55759 + compare_real_dp = 8.55759 + call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + + ! invalid test cases + x_real_dp = 3.025 + xmin_real_dp = 3.025 + xmax_real_dp = -5.77 + compare_real_dp = 3.025 + call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + + x_real_dp = -7.0 + xmin_real_dp = 1.00268 + xmax_real_dp = 0.059668 + compare_real_dp = 1.00268 + call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + + x_real_dp = -12.3358 + xmin_real_dp = 8.55759 + xmax_real_dp = 8.55759 + compare_real_dp = 8.55759 + call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + + ! type: real, kind: qp + ! valid test cases + x_real_qp = 3.025 + xmin_real_qp = -5.77 + xmax_real_qp = 3.025 + compare_real_qp = 3.025 + call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + + x_real_qp = -55891546.2 + xmin_real_qp = -8958133457.23 + xmax_real_qp = -689712245.23 + compare_real_qp = -689712245.23 + call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + + x_real_qp = 58.7 + xmin_real_qp = -2352.335 + xmax_real_qp = -189.58 + compare_real_qp = -189.58 + call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + + ! invalid test cases + x_real_qp = 3.025 + xmin_real_qp = 3.025 + xmax_real_qp = -5.77 + compare_real_qp = 3.025 + call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + + x_real_qp = -55891546.2 + xmin_real_qp = -689712245.23 + xmax_real_qp = -8958133457.23 + compare_real_qp = -689712245.23 + call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + + x_real_qp = 58.7 + xmin_real_qp = -189.58 + xmax_real_qp = -2352.335 + compare_real_qp = -189.58 + call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + + +end program tester diff --git a/src/tests/math/test_math.fypp b/src/tests/math/test_math.fypp new file mode 100644 index 000000000..49617a86e --- /dev/null +++ b/src/tests/math/test_math.fypp @@ -0,0 +1,80 @@ +! SPDX-Identifier: MIT + +#:set INT_KINDS_TYPES = [("int8", "integer"), ("int16", "integer"), ("int32", "integer"), ("int64", "integer")] +#:set REAL_KINDS_TYPES = [("sp", "real"), ("dp", "real"), ("qp", "real")] +#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + +module test_math + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp + use stdlib_error, only : check + use stdlib_math + + implicit none + + contains + #:for k1, t1 in IR_KINDS_TYPES + subroutine test_clip_${t1}$_${k1}$(x, xmin, xmax, compare) + ${t1}$(${k1}$), intent(in) :: x, xmin, xmax, compare + + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_${t1}$_${k1}$ + + #:endfor + +end module test_math + + +program tester + use test_math + implicit none + + ! test case format: (x, xmin, xmax, correct answer) + ! valid case: xmin is not greater than xmax + ! invalid case: xmin is greater than xmax + #:set valid_cases = [ [(2, -2, 5, 2), (127, -127, 0, 0), (-57, -57, 57, -57)], & + [(2, -2, 5, 2), (32767, -32767, 0, 0), (-598, -32, 676, -32)], & + [(2, -2, 5, 2), (-2147483647, 0, 2147483647, 0), (45732, -385769, 57642, 45732)], & + [(2, -2, 5, 2), (-922337203, -10, 25, -10), (97683, -200, 513788324, 97683)], & + [(3.025, -5.77, 3.025, 3.025), (0.0, -1578.025, -59.68, -59.68), (5.6, -97854.25, 2.3666, 2.3666)], & + [(3.025, -5.77, 3.025, 3.025), (-7.0, 0.059668, 1.00268, 0.059668), (-12.3358, 8.55759, 8.55759, 8.55759)], & + [(3.025, -5.77, 3.025, 3.025), (-55891546.2, -8958133457.23, -689712245.23, -689712245.23), (58.7, -2352.335, -189.58, -189.58)] ] + + #:set invalid_cases = [ [(2, 5, -2, 5), (127, 0, -127, 0), (-57, 57, -57, 57)], & + [(2, 5, -2, 5), (32767, 0, -32767, 0), (-598, 676, -32, 676)], & + [(2, 5, -2, 5), (-2147483647, 2147483647, 0, 2147483647), (45732, 57642, -385769, 57642)], & + [(2, 5, -2, 5), (-922337203, 25, -10, 25), (97683, 513788324, -200, 513788324)], & + [(3.025, 3.025, -5.77, 3.025), (0.0, -59.68, -1578.025, -59.68), (5.6, 2.3666, -97854.25, 2.3666)], & + [(3.025, 3.025, -5.77, 3.025), (-7.0, 1.00268, 0.059668, 1.00268), (-12.3358, 8.55759, 8.55759, 8.55759)], & + [(3.025, 3.025, -5.77, 3.025), (-55891546.2, -689712245.23, -8958133457.23, -689712245.23), (58.7, -189.58, -2352.335, -189.58)] ] + + #:set checking_function = 0 + ! data declaration + #:for k1, t1 in IR_KINDS_TYPES + ${t1}$(${k1}$) :: x_${t1}$_${k1}$, xmin_${t1}$_${k1}$, xmax_${t1}$_${k1}$, compare_${t1}$_${k1}$ + #:endfor + + #:for k1, t1 in IR_KINDS_TYPES + ! type: ${t1}$, kind: ${k1}$ + ! valid test cases + #:for case in valid_cases[checking_function] + x_${t1}$_${k1}$ = ${case[0]}$ + xmin_${t1}$_${k1}$ = ${case[1]}$ + xmax_${t1}$_${k1}$ = ${case[2]}$ + compare_${t1}$_${k1}$ = ${case[3]}$ + call test_clip_${t1}$_${k1}$(x_${t1}$_${k1}$, xmin_${t1}$_${k1}$, xmax_${t1}$_${k1}$, compare_${t1}$_${k1}$) + + #:endfor + ! invalid test cases + #:for case in invalid_cases[checking_function] + x_${t1}$_${k1}$ = ${case[0]}$ + xmin_${t1}$_${k1}$ = ${case[1]}$ + xmax_${t1}$_${k1}$ = ${case[2]}$ + compare_${t1}$_${k1}$ = ${case[3]}$ + call test_clip_${t1}$_${k1}$(x_${t1}$_${k1}$, xmin_${t1}$_${k1}$, xmax_${t1}$_${k1}$, compare_${t1}$_${k1}$) + + #:endfor + #:set checking_function = checking_function + 1 + #:endfor + +end program tester From 243ac910aed04c8e66204809e71e2b9ac3be0e2b Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 26 Mar 2021 16:52:06 +0530 Subject: [PATCH 03/16] documented clip function in newly created stdlib_math.md file --- doc/specs/stdlib_math.md | 101 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 doc/specs/stdlib_math.md diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md new file mode 100644 index 000000000..232664a29 --- /dev/null +++ b/doc/specs/stdlib_math.md @@ -0,0 +1,101 @@ +--- +title: math +--- + +# The `stdlib_math` module + +[TOC] + +## Introduction + +`stdlib_math` module provides with general purpose mathematical functions. + + +## Procedures and Methods provided + + + +### `clip` function + +#### Description + +Limits the input value `x` to the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive). Returns a value which lies in the given interval and is closest to the input value `x`. +If the input value `x` already lies in the given interval, then the output value will be equal to the input value. + +Note: A valid input must **NOT** have `xmin` value greater than `xmax` value. + +#### Syntax + +`res = [[stdlib_math(module):clip(interface)]] (x, xmin, xmax)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument(s) + +`x`: scalar of either `integer` or `real`. This argument is `intent(in)`. +`xmin`: scalar of either `integer` or `real`. This argument is `intent(in)`. +`xmax`: scalar of either `integer` or `real`. This argument is `intent(in)`. + +Note: All arguments must have same `type` and same `kind`. + +#### Output value or Result value + +Output is a scalar of either `integer` or `real` depending on the arguments. The output value will have `type` and `kind` same as to that of the arguments. + +#### Example(s) of usage + +##### Example 1: + +Here inputs are of type `integer` and kind `int32` +```fortran +program demo + use stdlib_math + use iso_fortran_env + implicit none + integer(int32) :: x + integer(int32) :: xmin + integer(int32) :: xmax + integer(int32) :: clipped_value + + xmin = -5 + ! xmin <- -5 + xmax = 5 + ! xmax <- 5 + x = 12 + ! x <- 12 + + clipped_value = clip(x, xmin, xmax) + ! clipped_value <- 5 +end program demo +``` + +##### Example 2: + +Here inputs are of type `real` and kind `real32` (or `sp`) +```fortran +program demo + use stdlib_math + use iso_fortran_env + implicit none + real(real32) :: x + real(real32) :: xmin + real(real32) :: xmax + real(real32) :: clipped_value + + xmin = -5.76999998 + ! xmin <- -5.76999998 + xmax = 3.02500010 + ! xmax <- 3.02500010 + x = 3.02500010 + ! x <- 3.02500010 + + clipped_value = clip(x, xmin, xmax) + ! clipped_value <- 3.02500010 +end program demo +``` From 336285d6a9219e4ac1afd468eae8329bc45f2cf9 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 27 Mar 2021 19:05:55 +0530 Subject: [PATCH 04/16] improved test_math.fypp: used int_8, _int16, _int32,... & removed some test_cases --- doc/specs/stdlib_math.md | 14 +- src/tests/math/test_math.f90 | 281 ++++------------------------------ src/tests/math/test_math.fypp | 49 +++--- 3 files changed, 53 insertions(+), 291 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 232664a29..7612d8c69 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -63,11 +63,11 @@ program demo integer(int32) :: xmax integer(int32) :: clipped_value - xmin = -5 + xmin = -5_int32 ! xmin <- -5 - xmax = 5 + xmax = 5_int32 ! xmax <- 5 - x = 12 + x = 12_int32 ! x <- 12 clipped_value = clip(x, xmin, xmax) @@ -88,11 +88,11 @@ program demo real(real32) :: xmax real(real32) :: clipped_value - xmin = -5.76999998 - ! xmin <- -5.76999998 - xmax = 3.02500010 + xmin = -5.769_real32 + ! xmin <- -5.76900005 + xmax = 3.025_real32 ! xmax <- 3.02500010 - x = 3.02500010 + x = 3.025_real32 ! x <- 3.02500010 clipped_value = clip(x, xmin, xmax) diff --git a/src/tests/math/test_math.f90 b/src/tests/math/test_math.f90 index f6afc10b8..8c18a4da5 100644 --- a/src/tests/math/test_math.f90 +++ b/src/tests/math/test_math.f90 @@ -71,287 +71,62 @@ program tester ! invalid case: xmin is greater than xmax - ! data declaration - integer(int8) :: x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8 - integer(int16) :: x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16 - integer(int32) :: x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32 - integer(int64) :: x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64 - real(sp) :: x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp - real(dp) :: x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp - real(qp) :: x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp ! type: integer, kind: int8 ! valid test cases - x_integer_int8 = 2 - xmin_integer_int8 = -2 - xmax_integer_int8 = 5 - compare_integer_int8 = 2 - call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) - - x_integer_int8 = 127 - xmin_integer_int8 = -127 - xmax_integer_int8 = 0 - compare_integer_int8 = 0 - call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) - - x_integer_int8 = -57 - xmin_integer_int8 = -57 - xmax_integer_int8 = 57 - compare_integer_int8 = -57 - call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) + call test_clip_integer_int8(2_int8, -2_int8, 5_int8, 2_int8) + call test_clip_integer_int8(127_int8, -127_int8, 0_int8, 0_int8) ! invalid test cases - x_integer_int8 = 2 - xmin_integer_int8 = 5 - xmax_integer_int8 = -2 - compare_integer_int8 = 5 - call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) - - x_integer_int8 = 127 - xmin_integer_int8 = 0 - xmax_integer_int8 = -127 - compare_integer_int8 = 0 - call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) - - x_integer_int8 = -57 - xmin_integer_int8 = 57 - xmax_integer_int8 = -57 - compare_integer_int8 = 57 - call test_clip_integer_int8(x_integer_int8, xmin_integer_int8, xmax_integer_int8, compare_integer_int8) - + call test_clip_integer_int8(2_int8, 5_int8, -2_int8, 5_int8) + call test_clip_integer_int8(127_int8, 0_int8, -127_int8, 0_int8) ! type: integer, kind: int16 ! valid test cases - x_integer_int16 = 2 - xmin_integer_int16 = -2 - xmax_integer_int16 = 5 - compare_integer_int16 = 2 - call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) - - x_integer_int16 = 32767 - xmin_integer_int16 = -32767 - xmax_integer_int16 = 0 - compare_integer_int16 = 0 - call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) - - x_integer_int16 = -598 - xmin_integer_int16 = -32 - xmax_integer_int16 = 676 - compare_integer_int16 = -32 - call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) + call test_clip_integer_int16(2_int16, -2_int16, 5_int16, 2_int16) + call test_clip_integer_int16(32767_int16, -32767_int16, 0_int16, 0_int16) ! invalid test cases - x_integer_int16 = 2 - xmin_integer_int16 = 5 - xmax_integer_int16 = -2 - compare_integer_int16 = 5 - call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) - - x_integer_int16 = 32767 - xmin_integer_int16 = 0 - xmax_integer_int16 = -32767 - compare_integer_int16 = 0 - call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) - - x_integer_int16 = -598 - xmin_integer_int16 = 676 - xmax_integer_int16 = -32 - compare_integer_int16 = 676 - call test_clip_integer_int16(x_integer_int16, xmin_integer_int16, xmax_integer_int16, compare_integer_int16) - + call test_clip_integer_int16(2_int16, 5_int16, -2_int16, 5_int16) + call test_clip_integer_int16(32767_int16, 0_int16, -32767_int16, 0_int16) ! type: integer, kind: int32 ! valid test cases - x_integer_int32 = 2 - xmin_integer_int32 = -2 - xmax_integer_int32 = 5 - compare_integer_int32 = 2 - call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) - - x_integer_int32 = -2147483647 - xmin_integer_int32 = 0 - xmax_integer_int32 = 2147483647 - compare_integer_int32 = 0 - call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) - - x_integer_int32 = 45732 - xmin_integer_int32 = -385769 - xmax_integer_int32 = 57642 - compare_integer_int32 = 45732 - call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) + call test_clip_integer_int32(2_int32, -2_int32, 5_int32, 2_int32) + call test_clip_integer_int32(-2147483647_int32, 0_int32, 2147483647_int32, 0_int32) ! invalid test cases - x_integer_int32 = 2 - xmin_integer_int32 = 5 - xmax_integer_int32 = -2 - compare_integer_int32 = 5 - call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) - - x_integer_int32 = -2147483647 - xmin_integer_int32 = 2147483647 - xmax_integer_int32 = 0 - compare_integer_int32 = 2147483647 - call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) - - x_integer_int32 = 45732 - xmin_integer_int32 = 57642 - xmax_integer_int32 = -385769 - compare_integer_int32 = 57642 - call test_clip_integer_int32(x_integer_int32, xmin_integer_int32, xmax_integer_int32, compare_integer_int32) - + call test_clip_integer_int32(2_int32, 5_int32, -2_int32, 5_int32) + call test_clip_integer_int32(-2147483647_int32, 2147483647_int32, 0_int32, 2147483647_int32) ! type: integer, kind: int64 ! valid test cases - x_integer_int64 = 2 - xmin_integer_int64 = -2 - xmax_integer_int64 = 5 - compare_integer_int64 = 2 - call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) - - x_integer_int64 = -922337203 - xmin_integer_int64 = -10 - xmax_integer_int64 = 25 - compare_integer_int64 = -10 - call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) - - x_integer_int64 = 97683 - xmin_integer_int64 = -200 - xmax_integer_int64 = 513788324 - compare_integer_int64 = 97683 - call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) + call test_clip_integer_int64(2_int64, -2_int64, 5_int64, 2_int64) + call test_clip_integer_int64(-922337203_int64, -10_int64, 25_int64, -10_int64) ! invalid test cases - x_integer_int64 = 2 - xmin_integer_int64 = 5 - xmax_integer_int64 = -2 - compare_integer_int64 = 5 - call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) - - x_integer_int64 = -922337203 - xmin_integer_int64 = 25 - xmax_integer_int64 = -10 - compare_integer_int64 = 25 - call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) - - x_integer_int64 = 97683 - xmin_integer_int64 = 513788324 - xmax_integer_int64 = -200 - compare_integer_int64 = 513788324 - call test_clip_integer_int64(x_integer_int64, xmin_integer_int64, xmax_integer_int64, compare_integer_int64) - + call test_clip_integer_int64(2_int64, 5_int64, -2_int64, 5_int64) + call test_clip_integer_int64(-922337203_int64, 25_int64, -10_int64, 25_int64) ! type: real, kind: sp ! valid test cases - x_real_sp = 3.025 - xmin_real_sp = -5.77 - xmax_real_sp = 3.025 - compare_real_sp = 3.025 - call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) - - x_real_sp = 0.0 - xmin_real_sp = -1578.025 - xmax_real_sp = -59.68 - compare_real_sp = -59.68 - call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) - - x_real_sp = 5.6 - xmin_real_sp = -97854.25 - xmax_real_sp = 2.3666 - compare_real_sp = 2.3666 - call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) + call test_clip_real_sp(3.025_sp, -5.77_sp, 3.025_sp, 3.025_sp) + call test_clip_real_sp(0.0_sp, -1578.025_sp, -59.68_sp, -59.68_sp) ! invalid test cases - x_real_sp = 3.025 - xmin_real_sp = 3.025 - xmax_real_sp = -5.77 - compare_real_sp = 3.025 - call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) - - x_real_sp = 0.0 - xmin_real_sp = -59.68 - xmax_real_sp = -1578.025 - compare_real_sp = -59.68 - call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) - - x_real_sp = 5.6 - xmin_real_sp = 2.3666 - xmax_real_sp = -97854.25 - compare_real_sp = 2.3666 - call test_clip_real_sp(x_real_sp, xmin_real_sp, xmax_real_sp, compare_real_sp) - + call test_clip_real_sp(3.025_sp, 3.025_sp, -5.77_sp, 3.025_sp) + call test_clip_real_sp(0.0_sp, -59.68_sp, -1578.025_sp, -59.68_sp) ! type: real, kind: dp ! valid test cases - x_real_dp = 3.025 - xmin_real_dp = -5.77 - xmax_real_dp = 3.025 - compare_real_dp = 3.025 - call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) - - x_real_dp = -7.0 - xmin_real_dp = 0.059668 - xmax_real_dp = 1.00268 - compare_real_dp = 0.059668 - call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) - - x_real_dp = -12.3358 - xmin_real_dp = 8.55759 - xmax_real_dp = 8.55759 - compare_real_dp = 8.55759 - call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) + call test_clip_real_dp(3.025_dp, -5.77_dp, 3.025_dp, 3.025_dp) + call test_clip_real_dp(-7.0_dp, 0.059668_dp, 1.00268_dp, 0.059668_dp) ! invalid test cases - x_real_dp = 3.025 - xmin_real_dp = 3.025 - xmax_real_dp = -5.77 - compare_real_dp = 3.025 - call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) - - x_real_dp = -7.0 - xmin_real_dp = 1.00268 - xmax_real_dp = 0.059668 - compare_real_dp = 1.00268 - call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) - - x_real_dp = -12.3358 - xmin_real_dp = 8.55759 - xmax_real_dp = 8.55759 - compare_real_dp = 8.55759 - call test_clip_real_dp(x_real_dp, xmin_real_dp, xmax_real_dp, compare_real_dp) - + call test_clip_real_dp(3.025_dp, 3.025_dp, -5.77_dp, 3.025_dp) + call test_clip_real_dp(-7.0_dp, 1.00268_dp, 0.059668_dp, 1.00268_dp) ! type: real, kind: qp ! valid test cases - x_real_qp = 3.025 - xmin_real_qp = -5.77 - xmax_real_qp = 3.025 - compare_real_qp = 3.025 - call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) - - x_real_qp = -55891546.2 - xmin_real_qp = -8958133457.23 - xmax_real_qp = -689712245.23 - compare_real_qp = -689712245.23 - call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) - - x_real_qp = 58.7 - xmin_real_qp = -2352.335 - xmax_real_qp = -189.58 - compare_real_qp = -189.58 - call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) + call test_clip_real_qp(3.025_qp, -5.77_qp, 3.025_qp, 3.025_qp) + call test_clip_real_qp(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp, -689712245.23_qp) ! invalid test cases - x_real_qp = 3.025 - xmin_real_qp = 3.025 - xmax_real_qp = -5.77 - compare_real_qp = 3.025 - call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) - - x_real_qp = -55891546.2 - xmin_real_qp = -689712245.23 - xmax_real_qp = -8958133457.23 - compare_real_qp = -689712245.23 - call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) - - x_real_qp = 58.7 - xmin_real_qp = -189.58 - xmax_real_qp = -2352.335 - compare_real_qp = -189.58 - call test_clip_real_qp(x_real_qp, xmin_real_qp, xmax_real_qp, compare_real_qp) - + call test_clip_real_qp(3.025_qp, 3.025_qp, -5.77_qp, 3.025_qp) + call test_clip_real_qp(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp, -689712245.23_qp) end program tester diff --git a/src/tests/math/test_math.fypp b/src/tests/math/test_math.fypp index 49617a86e..4f6d1792f 100644 --- a/src/tests/math/test_math.fypp +++ b/src/tests/math/test_math.fypp @@ -32,47 +32,34 @@ program tester ! test case format: (x, xmin, xmax, correct answer) ! valid case: xmin is not greater than xmax ! invalid case: xmin is greater than xmax - #:set valid_cases = [ [(2, -2, 5, 2), (127, -127, 0, 0), (-57, -57, 57, -57)], & - [(2, -2, 5, 2), (32767, -32767, 0, 0), (-598, -32, 676, -32)], & - [(2, -2, 5, 2), (-2147483647, 0, 2147483647, 0), (45732, -385769, 57642, 45732)], & - [(2, -2, 5, 2), (-922337203, -10, 25, -10), (97683, -200, 513788324, 97683)], & - [(3.025, -5.77, 3.025, 3.025), (0.0, -1578.025, -59.68, -59.68), (5.6, -97854.25, 2.3666, 2.3666)], & - [(3.025, -5.77, 3.025, 3.025), (-7.0, 0.059668, 1.00268, 0.059668), (-12.3358, 8.55759, 8.55759, 8.55759)], & - [(3.025, -5.77, 3.025, 3.025), (-55891546.2, -8958133457.23, -689712245.23, -689712245.23), (58.7, -2352.335, -189.58, -189.58)] ] - - #:set invalid_cases = [ [(2, 5, -2, 5), (127, 0, -127, 0), (-57, 57, -57, 57)], & - [(2, 5, -2, 5), (32767, 0, -32767, 0), (-598, 676, -32, 676)], & - [(2, 5, -2, 5), (-2147483647, 2147483647, 0, 2147483647), (45732, 57642, -385769, 57642)], & - [(2, 5, -2, 5), (-922337203, 25, -10, 25), (97683, 513788324, -200, 513788324)], & - [(3.025, 3.025, -5.77, 3.025), (0.0, -59.68, -1578.025, -59.68), (5.6, 2.3666, -97854.25, 2.3666)], & - [(3.025, 3.025, -5.77, 3.025), (-7.0, 1.00268, 0.059668, 1.00268), (-12.3358, 8.55759, 8.55759, 8.55759)], & - [(3.025, 3.025, -5.77, 3.025), (-55891546.2, -689712245.23, -8958133457.23, -689712245.23), (58.7, -189.58, -2352.335, -189.58)] ] + #:set valid_cases = [ [('2_int8', '-2_int8', '5_int8', '2_int8'), ('127_int8', '-127_int8', '0_int8', '0_int8')], & + [('2_int16', '-2_int16', '5_int16', '2_int16'), ('32767_int16', '-32767_int16', '0_int16', '0_int16')], & + [('2_int32', '-2_int32', '5_int32', '2_int32'), ('-2147483647_int32', '0_int32', '2147483647_int32', '0_int32')], & + [('2_int64', '-2_int64', '5_int64', '2_int64'), ('-922337203_int64', '-10_int64', '25_int64', '-10_int64')], & + [('3.025_sp', '-5.77_sp', '3.025_sp', '3.025_sp'), ('0.0_sp', '-1578.025_sp', '-59.68_sp', '-59.68_sp')], & + [('3.025_dp', '-5.77_dp', '3.025_dp', '3.025_dp'), ('-7.0_dp', '0.059668_dp', '1.00268_dp', '0.059668_dp')], & + [('3.025_qp', '-5.77_qp', '3.025_qp', '3.025_qp'), ('-55891546.2_qp', '-8958133457.23_qp', '-689712245.23_qp', '-689712245.23_qp')] ] + + #:set invalid_cases = [ [('2_int8', '5_int8', '-2_int8', '5_int8'), ('127_int8', '0_int8', '-127_int8', '0_int8')], & + [('2_int16', '5_int16', '-2_int16', '5_int16'), ('32767_int16', '0_int16', '-32767_int16', '0_int16')], & + [('2_int32', '5_int32', '-2_int32', '5_int32'), ('-2147483647_int32', '2147483647_int32', '0_int32', '2147483647_int32')], & + [('2_int64', '5_int64', '-2_int64', '5_int64'), ('-922337203_int64', '25_int64', '-10_int64', '25_int64')], & + [('3.025_sp', '3.025_sp', '-5.77_sp', '3.025_sp'), ('0.0_sp', '-59.68_sp', '-1578.025_sp', '-59.68_sp')], & + [('3.025_dp', '3.025_dp', '-5.77_dp', '3.025_dp'), ('-7.0_dp', '1.00268_dp', '0.059668_dp', '1.00268_dp')], & + [('3.025_qp', '3.025_qp', '-5.77_qp', '3.025_qp'), ('-55891546.2_qp', '-689712245.23_qp', '-8958133457.23_qp', '-689712245.23_qp')] ] #:set checking_function = 0 - ! data declaration - #:for k1, t1 in IR_KINDS_TYPES - ${t1}$(${k1}$) :: x_${t1}$_${k1}$, xmin_${t1}$_${k1}$, xmax_${t1}$_${k1}$, compare_${t1}$_${k1}$ - #:endfor #:for k1, t1 in IR_KINDS_TYPES ! type: ${t1}$, kind: ${k1}$ ! valid test cases #:for case in valid_cases[checking_function] - x_${t1}$_${k1}$ = ${case[0]}$ - xmin_${t1}$_${k1}$ = ${case[1]}$ - xmax_${t1}$_${k1}$ = ${case[2]}$ - compare_${t1}$_${k1}$ = ${case[3]}$ - call test_clip_${t1}$_${k1}$(x_${t1}$_${k1}$, xmin_${t1}$_${k1}$, xmax_${t1}$_${k1}$, compare_${t1}$_${k1}$) - + call test_clip_${t1}$_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) #:endfor + ! invalid test cases #:for case in invalid_cases[checking_function] - x_${t1}$_${k1}$ = ${case[0]}$ - xmin_${t1}$_${k1}$ = ${case[1]}$ - xmax_${t1}$_${k1}$ = ${case[2]}$ - compare_${t1}$_${k1}$ = ${case[3]}$ - call test_clip_${t1}$_${k1}$(x_${t1}$_${k1}$, xmin_${t1}$_${k1}$, xmax_${t1}$_${k1}$, compare_${t1}$_${k1}$) - + call test_clip_${t1}$_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) #:endfor #:set checking_function = checking_function + 1 #:endfor From 008506a63a3af4800a7e187befc93270be8ff126 Mon Sep 17 00:00:00 2001 From: Aman Godara <34789087+Aman-Godara@users.noreply.github.com> Date: Fri, 9 Apr 2021 00:19:37 +0530 Subject: [PATCH 05/16] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 7612d8c69..6f67aaa0e 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -48,7 +48,7 @@ Note: All arguments must have same `type` and same `kind`. Output is a scalar of either `integer` or `real` depending on the arguments. The output value will have `type` and `kind` same as to that of the arguments. -#### Example(s) of usage +#### Examples ##### Example 1: From a4272201a9eabff34e6db5b68d20f36764af0431 Mon Sep 17 00:00:00 2001 From: Aman Godara <34789087+Aman-Godara@users.noreply.github.com> Date: Fri, 9 Apr 2021 00:20:32 +0530 Subject: [PATCH 06/16] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 6f67aaa0e..6b3f7113a 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -8,7 +8,7 @@ title: math ## Introduction -`stdlib_math` module provides with general purpose mathematical functions. +`stdlib_math` module provides general purpose mathematical functions. ## Procedures and Methods provided From 7ba9853579b22949c4e6aed17096355b43c9cc23 Mon Sep 17 00:00:00 2001 From: milancurcic Date: Sun, 11 Apr 2021 13:07:13 -0400 Subject: [PATCH 07/16] fix indentation --- src/stdlib_math.fypp | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 29e647486..63df874b0 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -11,25 +11,23 @@ module stdlib_math private public :: clip - interface clip #:for k1, t1 in IR_KINDS_TYPES module procedure clip_${t1}$_${k1}$ #:endfor end interface clip - - contains +contains - #:for k1, t1 in IR_KINDS_TYPES - elemental function clip_${t1}$_${k1}$(x, xmin, xmax) result(res) - ${t1}$(${k1}$), intent(in) :: x - ${t1}$(${k1}$), intent(in) :: xmin - ${t1}$(${k1}$), intent(in) :: xmax - ${t1}$(${k1}$) :: res - res = max(min(x, xmax), xmin) - end function clip_${t1}$_${k1}$ + #:for k1, t1 in IR_KINDS_TYPES + elemental function clip_${t1}$_${k1}$(x, xmin, xmax) result(res) + ${t1}$(${k1}$), intent(in) :: x + ${t1}$(${k1}$), intent(in) :: xmin + ${t1}$(${k1}$), intent(in) :: xmax + ${t1}$(${k1}$) :: res + res = max(min(x, xmax), xmin) + end function clip_${t1}$_${k1}$ - #:endfor + #:endfor end module stdlib_math From 892236512c8e47d5c8d2debb9d23ed35906cd923 Mon Sep 17 00:00:00 2001 From: milancurcic Date: Sun, 11 Apr 2021 13:11:44 -0400 Subject: [PATCH 08/16] move the note about xmax > xmin requirement to the arguments spec --- doc/specs/stdlib_math.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 6b3f7113a..ed547c9b5 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -22,8 +22,6 @@ title: math Limits the input value `x` to the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive). Returns a value which lies in the given interval and is closest to the input value `x`. If the input value `x` already lies in the given interval, then the output value will be equal to the input value. -Note: A valid input must **NOT** have `xmin` value greater than `xmax` value. - #### Syntax `res = [[stdlib_math(module):clip(interface)]] (x, xmin, xmax)` @@ -40,7 +38,7 @@ Elemental function. `x`: scalar of either `integer` or `real`. This argument is `intent(in)`. `xmin`: scalar of either `integer` or `real`. This argument is `intent(in)`. -`xmax`: scalar of either `integer` or `real`. This argument is `intent(in)`. +`xmax`: scalar of either `integer` or `real`, which must be greater than or equal to `xmin`. This argument is `intent(in)`. Note: All arguments must have same `type` and same `kind`. From d6f9773d9f686ba9893c64adeb40322fd2ee2e0d Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 19 Apr 2021 03:18:55 +0530 Subject: [PATCH 09/16] Updated PR as per the feedback received --- doc/specs/stdlib_math.md | 39 ++++--- src/stdlib_math.fypp | 19 ++-- src/tests/math/test_math.f90 | 185 +++++++++++++++++----------------- src/tests/math/test_math.fypp | 40 ++++---- 4 files changed, 136 insertions(+), 147 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index ed547c9b5..0d7c7e668 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -19,8 +19,7 @@ title: math #### Description -Limits the input value `x` to the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive). Returns a value which lies in the given interval and is closest to the input value `x`. -If the input value `x` already lies in the given interval, then the output value will be equal to the input value. +Returns a value which lies in the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive) and is closest to the input value `x`. #### Syntax @@ -36,15 +35,15 @@ Elemental function. #### Argument(s) -`x`: scalar of either `integer` or `real`. This argument is `intent(in)`. -`xmin`: scalar of either `integer` or `real`. This argument is `intent(in)`. -`xmax`: scalar of either `integer` or `real`, which must be greater than or equal to `xmin`. This argument is `intent(in)`. +`x`: scalar of either `integer` or `real` type. This argument is `intent(in)`. +`xmin`: scalar of either `integer` or `real` type. This argument is `intent(in)`. +`xmax`: scalar of either `integer` or `real` type, which must be greater than or equal to `xmin`. This argument is `intent(in)`. Note: All arguments must have same `type` and same `kind`. #### Output value or Result value -Output is a scalar of either `integer` or `real` depending on the arguments. The output value will have `type` and `kind` same as to that of the arguments. +The output is a scalar of `type` and `kind` same as to that of the arguments. #### Examples @@ -52,9 +51,9 @@ Output is a scalar of either `integer` or `real` depending on the arguments. The Here inputs are of type `integer` and kind `int32` ```fortran -program demo +program demo_clip_integer use stdlib_math - use iso_fortran_env + use stdlib_kinds implicit none integer(int32) :: x integer(int32) :: xmin @@ -70,30 +69,30 @@ program demo clipped_value = clip(x, xmin, xmax) ! clipped_value <- 5 -end program demo +end program demo_clip_integer ``` ##### Example 2: -Here inputs are of type `real` and kind `real32` (or `sp`) +Here inputs are of type `real` and kind `sp` ```fortran -program demo +program demo_clip_real use stdlib_math - use iso_fortran_env + use stdlib_kinds implicit none - real(real32) :: x - real(real32) :: xmin - real(real32) :: xmax - real(real32) :: clipped_value + real(sp) :: x + real(sp) :: xmin + real(sp) :: xmax + real(sp) :: clipped_value - xmin = -5.769_real32 + xmin = -5.769_sp ! xmin <- -5.76900005 - xmax = 3.025_real32 + xmax = 3.025_sp ! xmax <- 3.02500010 - x = 3.025_real32 + x = 3.025_sp ! x <- 3.02500010 clipped_value = clip(x, xmin, xmax) ! clipped_value <- 3.02500010 -end program demo +end program demo_clip_real ``` diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 63df874b0..c5017d576 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,7 +1,4 @@ #:include "common.fypp" - -#:set INT_KINDS_TYPES = [("int8", "integer"), ("int16", "integer"), ("int32", "integer"), ("int64", "integer")] -#:set REAL_KINDS_TYPES = [("sp", "real"), ("dp", "real"), ("qp", "real")] #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES module stdlib_math @@ -13,21 +10,21 @@ module stdlib_math interface clip #:for k1, t1 in IR_KINDS_TYPES - module procedure clip_${t1}$_${k1}$ + module procedure clip_${k1}$ #:endfor end interface clip contains #:for k1, t1 in IR_KINDS_TYPES - elemental function clip_${t1}$_${k1}$(x, xmin, xmax) result(res) - ${t1}$(${k1}$), intent(in) :: x - ${t1}$(${k1}$), intent(in) :: xmin - ${t1}$(${k1}$), intent(in) :: xmax - ${t1}$(${k1}$) :: res + elemental function clip_${k1}$(x, xmin, xmax) result(res) + ${t1}$, intent(in) :: x + ${t1}$, intent(in) :: xmin + ${t1}$, intent(in) :: xmax + ${t1}$ :: res + res = max(min(x, xmax), xmin) - end function clip_${t1}$_${k1}$ + end function clip_${k1}$ #:endfor - end module stdlib_math diff --git a/src/tests/math/test_math.f90 b/src/tests/math/test_math.f90 index 8c18a4da5..aa404bf69 100644 --- a/src/tests/math/test_math.f90 +++ b/src/tests/math/test_math.f90 @@ -1,6 +1,5 @@ ! SPDX-Identifier: MIT - module test_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp use stdlib_error, only : check @@ -8,56 +7,56 @@ module test_math implicit none - contains - subroutine test_clip_integer_int8(x, xmin, xmax, compare) - integer(int8), intent(in) :: x, xmin, xmax, compare +contains - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_integer_int8 + subroutine test_clip_int8(x, xmin, xmax, compare) + integer(int8), intent(in) :: x, xmin, xmax, compare - subroutine test_clip_integer_int16(x, xmin, xmax, compare) - integer(int16), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_int8 - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_integer_int16 + subroutine test_clip_int16(x, xmin, xmax, compare) + integer(int16), intent(in) :: x, xmin, xmax, compare - subroutine test_clip_integer_int32(x, xmin, xmax, compare) - integer(int32), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_int16 - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_integer_int32 + subroutine test_clip_int32(x, xmin, xmax, compare) + integer(int32), intent(in) :: x, xmin, xmax, compare - subroutine test_clip_integer_int64(x, xmin, xmax, compare) - integer(int64), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_int32 - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_integer_int64 + subroutine test_clip_int64(x, xmin, xmax, compare) + integer(int64), intent(in) :: x, xmin, xmax, compare - subroutine test_clip_real_sp(x, xmin, xmax, compare) - real(sp), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_int64 - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_real_sp + subroutine test_clip_sp(x, xmin, xmax, compare) + real(sp), intent(in) :: x, xmin, xmax, compare - subroutine test_clip_real_dp(x, xmin, xmax, compare) - real(dp), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_sp - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_real_dp + subroutine test_clip_dp(x, xmin, xmax, compare) + real(dp), intent(in) :: x, xmin, xmax, compare - subroutine test_clip_real_qp(x, xmin, xmax, compare) - real(qp), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_dp - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_real_qp + subroutine test_clip_qp(x, xmin, xmax, compare) + real(qp), intent(in) :: x, xmin, xmax, compare + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_qp end module test_math @@ -71,62 +70,60 @@ program tester ! invalid case: xmin is greater than xmax - - ! type: integer, kind: int8 - ! valid test cases - call test_clip_integer_int8(2_int8, -2_int8, 5_int8, 2_int8) - call test_clip_integer_int8(127_int8, -127_int8, 0_int8, 0_int8) - - ! invalid test cases - call test_clip_integer_int8(2_int8, 5_int8, -2_int8, 5_int8) - call test_clip_integer_int8(127_int8, 0_int8, -127_int8, 0_int8) - ! type: integer, kind: int16 - ! valid test cases - call test_clip_integer_int16(2_int16, -2_int16, 5_int16, 2_int16) - call test_clip_integer_int16(32767_int16, -32767_int16, 0_int16, 0_int16) - - ! invalid test cases - call test_clip_integer_int16(2_int16, 5_int16, -2_int16, 5_int16) - call test_clip_integer_int16(32767_int16, 0_int16, -32767_int16, 0_int16) - ! type: integer, kind: int32 - ! valid test cases - call test_clip_integer_int32(2_int32, -2_int32, 5_int32, 2_int32) - call test_clip_integer_int32(-2147483647_int32, 0_int32, 2147483647_int32, 0_int32) - - ! invalid test cases - call test_clip_integer_int32(2_int32, 5_int32, -2_int32, 5_int32) - call test_clip_integer_int32(-2147483647_int32, 2147483647_int32, 0_int32, 2147483647_int32) - ! type: integer, kind: int64 - ! valid test cases - call test_clip_integer_int64(2_int64, -2_int64, 5_int64, 2_int64) - call test_clip_integer_int64(-922337203_int64, -10_int64, 25_int64, -10_int64) - - ! invalid test cases - call test_clip_integer_int64(2_int64, 5_int64, -2_int64, 5_int64) - call test_clip_integer_int64(-922337203_int64, 25_int64, -10_int64, 25_int64) - ! type: real, kind: sp - ! valid test cases - call test_clip_real_sp(3.025_sp, -5.77_sp, 3.025_sp, 3.025_sp) - call test_clip_real_sp(0.0_sp, -1578.025_sp, -59.68_sp, -59.68_sp) - - ! invalid test cases - call test_clip_real_sp(3.025_sp, 3.025_sp, -5.77_sp, 3.025_sp) - call test_clip_real_sp(0.0_sp, -59.68_sp, -1578.025_sp, -59.68_sp) - ! type: real, kind: dp - ! valid test cases - call test_clip_real_dp(3.025_dp, -5.77_dp, 3.025_dp, 3.025_dp) - call test_clip_real_dp(-7.0_dp, 0.059668_dp, 1.00268_dp, 0.059668_dp) - - ! invalid test cases - call test_clip_real_dp(3.025_dp, 3.025_dp, -5.77_dp, 3.025_dp) - call test_clip_real_dp(-7.0_dp, 1.00268_dp, 0.059668_dp, 1.00268_dp) - ! type: real, kind: qp - ! valid test cases - call test_clip_real_qp(3.025_qp, -5.77_qp, 3.025_qp, 3.025_qp) - call test_clip_real_qp(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp, -689712245.23_qp) - - ! invalid test cases - call test_clip_real_qp(3.025_qp, 3.025_qp, -5.77_qp, 3.025_qp) - call test_clip_real_qp(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp, -689712245.23_qp) + ! type: integer(int8), kind: int8 + ! valid test cases + call test_clip_int8(2_int8, -2_int8, 5_int8, 2_int8) + call test_clip_int8(127_int8, -127_int8, 0_int8, 0_int8) + ! invalid test cases + call test_clip_int8(2_int8, 5_int8, -2_int8, 5_int8) + call test_clip_int8(127_int8, 0_int8, -127_int8, 0_int8) + + ! type: integer(int16), kind: int16 + ! valid test cases + call test_clip_int16(2_int16, -2_int16, 5_int16, 2_int16) + call test_clip_int16(32767_int16, -32767_int16, 0_int16, 0_int16) + ! invalid test cases + call test_clip_int16(2_int16, 5_int16, -2_int16, 5_int16) + call test_clip_int16(32767_int16, 0_int16, -32767_int16, 0_int16) + + ! type: integer(int32), kind: int32 + ! valid test cases + call test_clip_int32(2_int32, -2_int32, 5_int32, 2_int32) + call test_clip_int32(-2147483647_int32, 0_int32, 2147483647_int32, 0_int32) + ! invalid test cases + call test_clip_int32(2_int32, 5_int32, -2_int32, 5_int32) + call test_clip_int32(-2147483647_int32, 2147483647_int32, 0_int32, 2147483647_int32) + + ! type: integer(int64), kind: int64 + ! valid test cases + call test_clip_int64(2_int64, -2_int64, 5_int64, 2_int64) + call test_clip_int64(-922337203_int64, -10_int64, 25_int64, -10_int64) + ! invalid test cases + call test_clip_int64(2_int64, 5_int64, -2_int64, 5_int64) + call test_clip_int64(-922337203_int64, 25_int64, -10_int64, 25_int64) + + ! type: real(sp), kind: sp + ! valid test cases + call test_clip_sp(3.025_sp, -5.77_sp, 3.025_sp, 3.025_sp) + call test_clip_sp(0.0_sp, -1578.025_sp, -59.68_sp, -59.68_sp) + ! invalid test cases + call test_clip_sp(3.025_sp, 3.025_sp, -5.77_sp, 3.025_sp) + call test_clip_sp(0.0_sp, -59.68_sp, -1578.025_sp, -59.68_sp) + + ! type: real(dp), kind: dp + ! valid test cases + call test_clip_dp(3.025_dp, -5.77_dp, 3.025_dp, 3.025_dp) + call test_clip_dp(-7.0_dp, 0.059668_dp, 1.00268_dp, 0.059668_dp) + ! invalid test cases + call test_clip_dp(3.025_dp, 3.025_dp, -5.77_dp, 3.025_dp) + call test_clip_dp(-7.0_dp, 1.00268_dp, 0.059668_dp, 1.00268_dp) + + ! type: real(qp), kind: qp + ! valid test cases + call test_clip_qp(3.025_qp, -5.77_qp, 3.025_qp, 3.025_qp) + call test_clip_qp(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp, -689712245.23_qp) + ! invalid test cases + call test_clip_qp(3.025_qp, 3.025_qp, -5.77_qp, 3.025_qp) + call test_clip_qp(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp, -689712245.23_qp) end program tester diff --git a/src/tests/math/test_math.fypp b/src/tests/math/test_math.fypp index 4f6d1792f..7a102e341 100644 --- a/src/tests/math/test_math.fypp +++ b/src/tests/math/test_math.fypp @@ -1,7 +1,5 @@ ! SPDX-Identifier: MIT - -#:set INT_KINDS_TYPES = [("int8", "integer"), ("int16", "integer"), ("int32", "integer"), ("int64", "integer")] -#:set REAL_KINDS_TYPES = [("sp", "real"), ("dp", "real"), ("qp", "real")] +#:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES module test_math @@ -11,17 +9,17 @@ module test_math implicit none - contains +contains + #:for k1, t1 in IR_KINDS_TYPES - subroutine test_clip_${t1}$_${k1}$(x, xmin, xmax, compare) - ${t1}$(${k1}$), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_${k1}$(x, xmin, xmax, compare) + ${t1}$, intent(in) :: x, xmin, xmax, compare - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_${t1}$_${k1}$ + call check(clip(x, xmin, xmax) == compare) + + end subroutine test_clip_${k1}$ #:endfor - end module test_math @@ -49,19 +47,17 @@ program tester [('3.025_qp', '3.025_qp', '-5.77_qp', '3.025_qp'), ('-55891546.2_qp', '-689712245.23_qp', '-8958133457.23_qp', '-689712245.23_qp')] ] #:set checking_function = 0 - #:for k1, t1 in IR_KINDS_TYPES - ! type: ${t1}$, kind: ${k1}$ - ! valid test cases - #:for case in valid_cases[checking_function] - call test_clip_${t1}$_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) - #:endfor - - ! invalid test cases - #:for case in invalid_cases[checking_function] - call test_clip_${t1}$_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) - #:endfor - #:set checking_function = checking_function + 1 + ! type: ${t1}$, kind: ${k1}$ + ! valid test cases + #:for case in valid_cases[checking_function] + call test_clip_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) + #:endfor + ! invalid test cases + #:for case in invalid_cases[checking_function] + call test_clip_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) #:endfor + #:set checking_function = checking_function + 1 + #:endfor end program tester From d17df5e199716e94f97f701f99a356e366aaec69 Mon Sep 17 00:00:00 2001 From: Aman Godara <34789087+Aman-Godara@users.noreply.github.com> Date: Mon, 19 Apr 2021 03:41:09 +0530 Subject: [PATCH 10/16] Deleted test_math.fypp file from PR --- src/tests/math/test_math.fypp | 63 ----------------------------------- 1 file changed, 63 deletions(-) delete mode 100644 src/tests/math/test_math.fypp diff --git a/src/tests/math/test_math.fypp b/src/tests/math/test_math.fypp deleted file mode 100644 index 7a102e341..000000000 --- a/src/tests/math/test_math.fypp +++ /dev/null @@ -1,63 +0,0 @@ -! SPDX-Identifier: MIT -#:include "common.fypp" -#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES - -module test_math - use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp - use stdlib_error, only : check - use stdlib_math - - implicit none - -contains - - #:for k1, t1 in IR_KINDS_TYPES - subroutine test_clip_${k1}$(x, xmin, xmax, compare) - ${t1}$, intent(in) :: x, xmin, xmax, compare - - call check(clip(x, xmin, xmax) == compare) - - end subroutine test_clip_${k1}$ - - #:endfor -end module test_math - - -program tester - use test_math - implicit none - - ! test case format: (x, xmin, xmax, correct answer) - ! valid case: xmin is not greater than xmax - ! invalid case: xmin is greater than xmax - #:set valid_cases = [ [('2_int8', '-2_int8', '5_int8', '2_int8'), ('127_int8', '-127_int8', '0_int8', '0_int8')], & - [('2_int16', '-2_int16', '5_int16', '2_int16'), ('32767_int16', '-32767_int16', '0_int16', '0_int16')], & - [('2_int32', '-2_int32', '5_int32', '2_int32'), ('-2147483647_int32', '0_int32', '2147483647_int32', '0_int32')], & - [('2_int64', '-2_int64', '5_int64', '2_int64'), ('-922337203_int64', '-10_int64', '25_int64', '-10_int64')], & - [('3.025_sp', '-5.77_sp', '3.025_sp', '3.025_sp'), ('0.0_sp', '-1578.025_sp', '-59.68_sp', '-59.68_sp')], & - [('3.025_dp', '-5.77_dp', '3.025_dp', '3.025_dp'), ('-7.0_dp', '0.059668_dp', '1.00268_dp', '0.059668_dp')], & - [('3.025_qp', '-5.77_qp', '3.025_qp', '3.025_qp'), ('-55891546.2_qp', '-8958133457.23_qp', '-689712245.23_qp', '-689712245.23_qp')] ] - - #:set invalid_cases = [ [('2_int8', '5_int8', '-2_int8', '5_int8'), ('127_int8', '0_int8', '-127_int8', '0_int8')], & - [('2_int16', '5_int16', '-2_int16', '5_int16'), ('32767_int16', '0_int16', '-32767_int16', '0_int16')], & - [('2_int32', '5_int32', '-2_int32', '5_int32'), ('-2147483647_int32', '2147483647_int32', '0_int32', '2147483647_int32')], & - [('2_int64', '5_int64', '-2_int64', '5_int64'), ('-922337203_int64', '25_int64', '-10_int64', '25_int64')], & - [('3.025_sp', '3.025_sp', '-5.77_sp', '3.025_sp'), ('0.0_sp', '-59.68_sp', '-1578.025_sp', '-59.68_sp')], & - [('3.025_dp', '3.025_dp', '-5.77_dp', '3.025_dp'), ('-7.0_dp', '1.00268_dp', '0.059668_dp', '1.00268_dp')], & - [('3.025_qp', '3.025_qp', '-5.77_qp', '3.025_qp'), ('-55891546.2_qp', '-689712245.23_qp', '-8958133457.23_qp', '-689712245.23_qp')] ] - - #:set checking_function = 0 - #:for k1, t1 in IR_KINDS_TYPES - ! type: ${t1}$, kind: ${k1}$ - ! valid test cases - #:for case in valid_cases[checking_function] - call test_clip_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) - #:endfor - ! invalid test cases - #:for case in invalid_cases[checking_function] - call test_clip_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$) - #:endfor - - #:set checking_function = checking_function + 1 - #:endfor -end program tester From 5987902552b41229b839ea2baf4536a4a19db429 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Wed, 21 Apr 2021 09:48:55 +0200 Subject: [PATCH 11/16] Fix separator in testing Makefile --- src/tests/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index c5ed006f0..e8fdbc139 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -9,4 +9,4 @@ all test clean: $(MAKE) -f Makefile.manual --directory=quadrature $@ $(MAKE) -f Makefile.manual --directory=stats $@ $(MAKE) -f Makefile.manual --directory=string $@ - $(MAKE) -f Makefile.manual --directory=math $@ + $(MAKE) -f Makefile.manual --directory=math $@ From c3ae302f545ff2d00b7f5620a6ac1102e5124891 Mon Sep 17 00:00:00 2001 From: Aman Godara <34789087+Aman-Godara@users.noreply.github.com> Date: Thu, 22 Apr 2021 19:20:16 +0530 Subject: [PATCH 12/16] removed auto-generation of empty line by .fypp file, updated stdlib_math.md Co-authored-by: Ivan Pribec --- doc/specs/stdlib_math.md | 8 ++++---- src/stdlib_math.fypp | 1 - 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 0d7c7e668..cbbcdd9bf 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -52,8 +52,8 @@ The output is a scalar of `type` and `kind` same as to that of the arguments. Here inputs are of type `integer` and kind `int32` ```fortran program demo_clip_integer - use stdlib_math - use stdlib_kinds + use stdlib_math, only: clip + use stdlib_kinds, only: int32 implicit none integer(int32) :: x integer(int32) :: xmin @@ -77,8 +77,8 @@ end program demo_clip_integer Here inputs are of type `real` and kind `sp` ```fortran program demo_clip_real - use stdlib_math - use stdlib_kinds + use stdlib_math, only: clip + use stdlib_kinds, only: sp implicit none real(sp) :: x real(sp) :: xmin diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index c5017d576..af8a76439 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -25,6 +25,5 @@ contains res = max(min(x, xmax), xmin) end function clip_${k1}$ - #:endfor end module stdlib_math From d66cee2b7a39672f8466e4a41d1ab0d61cb13735 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Thu, 22 Apr 2021 21:34:24 +0530 Subject: [PATCH 13/16] changed indentation, added empty line in .fypp file back, replaced compare with answer, improved test_math.f90 --- src/Makefile.manual | 2 +- src/stdlib_math.fypp | 1 + src/tests/math/test_math.f90 | 42 ++++++++++++++++++------------------ 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 1d5d202e7..169d61a19 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -19,7 +19,7 @@ SRCFYPP =\ stdlib_stats_moment_mask.fypp \ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ - stdlib_math.fypp \ + stdlib_math.fypp \ stdlib_stats_distribution_PRNG.fypp \ stdlib_string_type.fypp diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index af8a76439..fc00d94f8 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -25,5 +25,6 @@ contains res = max(min(x, xmax), xmin) end function clip_${k1}$ + #:endfor end module stdlib_math diff --git a/src/tests/math/test_math.f90 b/src/tests/math/test_math.f90 index aa404bf69..e5b09d549 100644 --- a/src/tests/math/test_math.f90 +++ b/src/tests/math/test_math.f90 @@ -9,52 +9,52 @@ module test_math contains - subroutine test_clip_int8(x, xmin, xmax, compare) - integer(int8), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_int8(x, xmin, xmax, answer) + integer(int8), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_int8 failed.', warn=.true.) end subroutine test_clip_int8 - subroutine test_clip_int16(x, xmin, xmax, compare) - integer(int16), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_int16(x, xmin, xmax, answer) + integer(int16), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_int16 failed.', warn=.true.) end subroutine test_clip_int16 - subroutine test_clip_int32(x, xmin, xmax, compare) - integer(int32), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_int32(x, xmin, xmax, answer) + integer(int32), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_int32 failed.', warn=.true.) end subroutine test_clip_int32 - subroutine test_clip_int64(x, xmin, xmax, compare) - integer(int64), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_int64(x, xmin, xmax, answer) + integer(int64), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_int64 failed.', warn=.true.) end subroutine test_clip_int64 - subroutine test_clip_sp(x, xmin, xmax, compare) - real(sp), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_sp(x, xmin, xmax, answer) + real(sp), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_sp failed.', warn=.true.) end subroutine test_clip_sp - subroutine test_clip_dp(x, xmin, xmax, compare) - real(dp), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_dp(x, xmin, xmax, answer) + real(dp), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_dp failed.', warn=.true.) end subroutine test_clip_dp - subroutine test_clip_qp(x, xmin, xmax, compare) - real(qp), intent(in) :: x, xmin, xmax, compare + subroutine test_clip_qp(x, xmin, xmax, answer) + real(qp), intent(in) :: x, xmin, xmax, answer - call check(clip(x, xmin, xmax) == compare) + call check(clip(x, xmin, xmax) == answer, 'test_clip_qp failed.', warn=.true.) end subroutine test_clip_qp From 542c024a03708421637876a40831b0a263bada81 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 24 Apr 2021 15:02:15 +0530 Subject: [PATCH 14/16] removed wrapper test_clip, renamed test_math to test_stdlib_math --- doc/specs/stdlib_math.md | 6 -- src/Makefile.manual | 2 +- src/tests/math/CMakeLists.txt | 2 +- src/tests/math/Makefile.manual | 2 +- src/tests/math/test_math.f90 | 129 ---------------------------- src/tests/math/test_stdlib_math.f90 | 97 +++++++++++++++++++++ 6 files changed, 100 insertions(+), 138 deletions(-) delete mode 100644 src/tests/math/test_math.f90 create mode 100644 src/tests/math/test_stdlib_math.f90 diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index cbbcdd9bf..3e45b6696 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -61,11 +61,8 @@ program demo_clip_integer integer(int32) :: clipped_value xmin = -5_int32 - ! xmin <- -5 xmax = 5_int32 - ! xmax <- 5 x = 12_int32 - ! x <- 12 clipped_value = clip(x, xmin, xmax) ! clipped_value <- 5 @@ -86,11 +83,8 @@ program demo_clip_real real(sp) :: clipped_value xmin = -5.769_sp - ! xmin <- -5.76900005 xmax = 3.025_sp - ! xmax <- 3.02500010 x = 3.025_sp - ! x <- 3.02500010 clipped_value = clip(x, xmin, xmax) ! clipped_value <- 3.02500010 diff --git a/src/Makefile.manual b/src/Makefile.manual index 169d61a19..8ad3fe61a 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -19,7 +19,7 @@ SRCFYPP =\ stdlib_stats_moment_mask.fypp \ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ - stdlib_math.fypp \ + stdlib_math.fypp \ stdlib_stats_distribution_PRNG.fypp \ stdlib_string_type.fypp diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index 963baf78a..ed5f32894 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -1 +1 @@ -ADDTEST(math) +ADDTEST(stdlib_math) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index 1ec3f5b3f..de5f87d26 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -1,4 +1,4 @@ -PROGS_SRC = test_math.f90 +PROGS_SRC = test_stdlib_math.f90 include ../Makefile.manual.test.mk diff --git a/src/tests/math/test_math.f90 b/src/tests/math/test_math.f90 deleted file mode 100644 index e5b09d549..000000000 --- a/src/tests/math/test_math.f90 +++ /dev/null @@ -1,129 +0,0 @@ -! SPDX-Identifier: MIT - -module test_math - use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp - use stdlib_error, only : check - use stdlib_math - - implicit none - -contains - - subroutine test_clip_int8(x, xmin, xmax, answer) - integer(int8), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_int8 failed.', warn=.true.) - - end subroutine test_clip_int8 - - subroutine test_clip_int16(x, xmin, xmax, answer) - integer(int16), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_int16 failed.', warn=.true.) - - end subroutine test_clip_int16 - - subroutine test_clip_int32(x, xmin, xmax, answer) - integer(int32), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_int32 failed.', warn=.true.) - - end subroutine test_clip_int32 - - subroutine test_clip_int64(x, xmin, xmax, answer) - integer(int64), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_int64 failed.', warn=.true.) - - end subroutine test_clip_int64 - - subroutine test_clip_sp(x, xmin, xmax, answer) - real(sp), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_sp failed.', warn=.true.) - - end subroutine test_clip_sp - - subroutine test_clip_dp(x, xmin, xmax, answer) - real(dp), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_dp failed.', warn=.true.) - - end subroutine test_clip_dp - - subroutine test_clip_qp(x, xmin, xmax, answer) - real(qp), intent(in) :: x, xmin, xmax, answer - - call check(clip(x, xmin, xmax) == answer, 'test_clip_qp failed.', warn=.true.) - - end subroutine test_clip_qp - -end module test_math - - -program tester - use test_math - implicit none - - ! test case format: (x, xmin, xmax, correct answer) - ! valid case: xmin is not greater than xmax - ! invalid case: xmin is greater than xmax - - - ! type: integer(int8), kind: int8 - ! valid test cases - call test_clip_int8(2_int8, -2_int8, 5_int8, 2_int8) - call test_clip_int8(127_int8, -127_int8, 0_int8, 0_int8) - ! invalid test cases - call test_clip_int8(2_int8, 5_int8, -2_int8, 5_int8) - call test_clip_int8(127_int8, 0_int8, -127_int8, 0_int8) - - ! type: integer(int16), kind: int16 - ! valid test cases - call test_clip_int16(2_int16, -2_int16, 5_int16, 2_int16) - call test_clip_int16(32767_int16, -32767_int16, 0_int16, 0_int16) - ! invalid test cases - call test_clip_int16(2_int16, 5_int16, -2_int16, 5_int16) - call test_clip_int16(32767_int16, 0_int16, -32767_int16, 0_int16) - - ! type: integer(int32), kind: int32 - ! valid test cases - call test_clip_int32(2_int32, -2_int32, 5_int32, 2_int32) - call test_clip_int32(-2147483647_int32, 0_int32, 2147483647_int32, 0_int32) - ! invalid test cases - call test_clip_int32(2_int32, 5_int32, -2_int32, 5_int32) - call test_clip_int32(-2147483647_int32, 2147483647_int32, 0_int32, 2147483647_int32) - - ! type: integer(int64), kind: int64 - ! valid test cases - call test_clip_int64(2_int64, -2_int64, 5_int64, 2_int64) - call test_clip_int64(-922337203_int64, -10_int64, 25_int64, -10_int64) - ! invalid test cases - call test_clip_int64(2_int64, 5_int64, -2_int64, 5_int64) - call test_clip_int64(-922337203_int64, 25_int64, -10_int64, 25_int64) - - ! type: real(sp), kind: sp - ! valid test cases - call test_clip_sp(3.025_sp, -5.77_sp, 3.025_sp, 3.025_sp) - call test_clip_sp(0.0_sp, -1578.025_sp, -59.68_sp, -59.68_sp) - ! invalid test cases - call test_clip_sp(3.025_sp, 3.025_sp, -5.77_sp, 3.025_sp) - call test_clip_sp(0.0_sp, -59.68_sp, -1578.025_sp, -59.68_sp) - - ! type: real(dp), kind: dp - ! valid test cases - call test_clip_dp(3.025_dp, -5.77_dp, 3.025_dp, 3.025_dp) - call test_clip_dp(-7.0_dp, 0.059668_dp, 1.00268_dp, 0.059668_dp) - ! invalid test cases - call test_clip_dp(3.025_dp, 3.025_dp, -5.77_dp, 3.025_dp) - call test_clip_dp(-7.0_dp, 1.00268_dp, 0.059668_dp, 1.00268_dp) - - ! type: real(qp), kind: qp - ! valid test cases - call test_clip_qp(3.025_qp, -5.77_qp, 3.025_qp, 3.025_qp) - call test_clip_qp(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp, -689712245.23_qp) - ! invalid test cases - call test_clip_qp(3.025_qp, 3.025_qp, -5.77_qp, 3.025_qp) - call test_clip_qp(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp, -689712245.23_qp) - -end program tester diff --git a/src/tests/math/test_stdlib_math.f90 b/src/tests/math/test_stdlib_math.f90 new file mode 100644 index 000000000..df52c89f6 --- /dev/null +++ b/src/tests/math/test_stdlib_math.f90 @@ -0,0 +1,97 @@ +! SPDX-Identifier: MIT + +program tester + use stdlib_math, only: clip + use stdlib_error, only: check + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp + implicit none + + ! test case format: (x, xmin, xmax, correct answer) + ! valid case: xmin is not greater than xmax + ! invalid case: xmin is greater than xmax + + ! type: integer(int8), kind: int8 + ! valid test case + call check(clip(2_int8, -2_int8, 5_int8) == 2_int8, & + 'clip_int8 failed for valid case', warn=.true.) + call check(clip(127_int8, -127_int8, 0_int8) == 0_int8, & + 'clip_int8 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int8, 5_int8, -2_int8) == 5_int8, & + 'clip_int8 failed for invalid case', warn=.true.) + call check(clip(127_int8, 0_int8, -127_int8) == 0_int8, & + 'clip_int8 failed for invalid case', warn=.true.) + + ! type: integer(int16), kind: int16 + ! valid test case + call check(clip(2_int16, -2_int16, 5_int16) == 2_int16, & + 'clip_int16 failed for valid case', warn=.true.) + call check(clip(32767_int16, -32767_int16, 0_int16) == 0_int16, & + 'clip_int16 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int16, 5_int16, -2_int16) == 5_int16, & + 'clip_int16 failed for invalid case', warn=.true.) + call check(clip(32767_int16, 0_int16, -32767_int16) == 0_int16, & + 'clip_int16 failed for invalid case', warn=.true.) + + ! type: integer(int32), kind: int32 + ! valid test case + call check(clip(2_int32, -2_int32, 5_int32) == 2_int32, & + 'clip_int32 failed for valid case', warn=.true.) + call check(clip(-2147483647_int32, 0_int32, 2147483647_int32) == 0_int32, & + 'clip_int32 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int32, 5_int32, -2_int32) == 5_int32, & + 'clip_int32 failed for invalid case', warn=.true.) + call check(clip(-2147483647_int32, 2147483647_int32, 0_int32) == 2147483647_int32, & + 'clip_int32 failed for invalid case', warn=.true.) + + ! type: integer(int64), kind: int64 + ! valid test case + call check(clip(2_int64, -2_int64, 5_int64) == 2_int64, & + 'clip_int64 failed for valid case', warn=.true.) + call check(clip(-922337203_int64, -10_int64, 25_int64) == -10_int64, & + 'clip_int64 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int64, 5_int64, -2_int64) == 5_int64, & + 'clip_int64 failed for invalid case', warn=.true.) + call check(clip(-922337203_int64, 25_int64, -10_int64) == 25_int64, & + 'clip_int64 failed for invalid case', warn=.true.) + + ! type: real(sp), kind: sp + ! valid test case + call check(clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp, & + 'clip_sp failed for valid case', warn=.true.) + call check(clip(0.0_sp, -1578.025_sp, -59.68_sp) == -59.68_sp, & + 'clip_sp failed for valid case', warn=.true.) + ! invalid test case + call check(clip(3.025_sp, 3.025_sp, -5.77_sp) == 3.025_sp, & + 'clip_sp failed for invalid case', warn=.true.) + call check(clip(0.0_sp, -59.68_sp, -1578.025_sp) == -59.68_sp, & + 'clip_sp failed for invalid case', warn=.true.) + + ! type: real(dp), kind: dp + ! valid test case + call check(clip(3.025_dp, -5.77_dp, 3.025_dp) == 3.025_dp, & + 'clip_dp failed for valid case', warn=.true.) + call check(clip(-7.0_dp, 0.059668_dp, 1.00268_dp) == 0.059668_dp, & + 'clip_dp failed for valid case', warn=.true.) + ! invalid test case + call check(clip(3.025_dp, 3.025_dp, -5.77_dp) == 3.025_dp, & + 'clip_dp failed for invalid case', warn=.true.) + call check(clip(-7.0_dp, 1.00268_dp, 0.059668_dp) == 1.00268_dp, & + 'clip_dp failed for invalid case', warn=.true.) + + ! type: real(qp), kind: qp + ! valid test case + call check(clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp, & + 'clip_qp failed for valid case', warn=.true.) + call check(clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp) == -689712245.23_qp, & + 'clip_qp failed for valid case', warn=.true.) + ! invalid test case + call check(clip(3.025_qp, 3.025_qp, -5.77_qp) == 3.025_qp, & + 'clip_qp failed for invalid case', warn=.true.) + call check(clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp) == -689712245.23_qp, & + 'clip_qp failed for invalid case', warn=.true.) + +end program tester From fd684bd76cea62f29941d8c74b708f24257f0815 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 24 Apr 2021 15:52:48 +0530 Subject: [PATCH 15/16] improved aesthetics of test_stdlib_math.f90 file --- src/tests/math/test_stdlib_math.f90 | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/tests/math/test_stdlib_math.f90 b/src/tests/math/test_stdlib_math.f90 index df52c89f6..2202ecd60 100644 --- a/src/tests/math/test_stdlib_math.f90 +++ b/src/tests/math/test_stdlib_math.f90 @@ -6,11 +6,12 @@ program tester use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp implicit none - ! test case format: (x, xmin, xmax, correct answer) - ! valid case: xmin is not greater than xmax - ! invalid case: xmin is greater than xmax + ! clip function + ! testing format: check(clip(x, xmin, xmax) == correct answer) + ! valid case: xmin is not greater than xmax + ! invalid case: xmin is greater than xmax - ! type: integer(int8), kind: int8 + ! type: integer(int8), kind: int8 ! valid test case call check(clip(2_int8, -2_int8, 5_int8) == 2_int8, & 'clip_int8 failed for valid case', warn=.true.) @@ -22,7 +23,7 @@ program tester call check(clip(127_int8, 0_int8, -127_int8) == 0_int8, & 'clip_int8 failed for invalid case', warn=.true.) - ! type: integer(int16), kind: int16 + ! type: integer(int16), kind: int16 ! valid test case call check(clip(2_int16, -2_int16, 5_int16) == 2_int16, & 'clip_int16 failed for valid case', warn=.true.) @@ -34,7 +35,7 @@ program tester call check(clip(32767_int16, 0_int16, -32767_int16) == 0_int16, & 'clip_int16 failed for invalid case', warn=.true.) - ! type: integer(int32), kind: int32 + ! type: integer(int32), kind: int32 ! valid test case call check(clip(2_int32, -2_int32, 5_int32) == 2_int32, & 'clip_int32 failed for valid case', warn=.true.) @@ -46,7 +47,7 @@ program tester call check(clip(-2147483647_int32, 2147483647_int32, 0_int32) == 2147483647_int32, & 'clip_int32 failed for invalid case', warn=.true.) - ! type: integer(int64), kind: int64 + ! type: integer(int64), kind: int64 ! valid test case call check(clip(2_int64, -2_int64, 5_int64) == 2_int64, & 'clip_int64 failed for valid case', warn=.true.) @@ -58,7 +59,7 @@ program tester call check(clip(-922337203_int64, 25_int64, -10_int64) == 25_int64, & 'clip_int64 failed for invalid case', warn=.true.) - ! type: real(sp), kind: sp + ! type: real(sp), kind: sp ! valid test case call check(clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp, & 'clip_sp failed for valid case', warn=.true.) @@ -70,7 +71,7 @@ program tester call check(clip(0.0_sp, -59.68_sp, -1578.025_sp) == -59.68_sp, & 'clip_sp failed for invalid case', warn=.true.) - ! type: real(dp), kind: dp + ! type: real(dp), kind: dp ! valid test case call check(clip(3.025_dp, -5.77_dp, 3.025_dp) == 3.025_dp, & 'clip_dp failed for valid case', warn=.true.) @@ -82,7 +83,7 @@ program tester call check(clip(-7.0_dp, 1.00268_dp, 0.059668_dp) == 1.00268_dp, & 'clip_dp failed for invalid case', warn=.true.) - ! type: real(qp), kind: qp + ! type: real(qp), kind: qp ! valid test case call check(clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp, & 'clip_qp failed for valid case', warn=.true.) From f4ffaa656f86998dc06e6f01b0ec0394f7e8cb86 Mon Sep 17 00:00:00 2001 From: milancurcic Date: Mon, 26 Apr 2021 09:41:45 -0400 Subject: [PATCH 16/16] update program name and fix indentation --- src/tests/math/test_stdlib_math.f90 | 164 ++++++++++++++-------------- 1 file changed, 82 insertions(+), 82 deletions(-) diff --git a/src/tests/math/test_stdlib_math.f90 b/src/tests/math/test_stdlib_math.f90 index 2202ecd60..7fafc6bfe 100644 --- a/src/tests/math/test_stdlib_math.f90 +++ b/src/tests/math/test_stdlib_math.f90 @@ -1,98 +1,98 @@ ! SPDX-Identifier: MIT -program tester +program test_stdlib_math use stdlib_math, only: clip use stdlib_error, only: check use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp implicit none ! clip function - ! testing format: check(clip(x, xmin, xmax) == correct answer) - ! valid case: xmin is not greater than xmax - ! invalid case: xmin is greater than xmax + ! testing format: check(clip(x, xmin, xmax) == correct answer) + ! valid case: xmin is not greater than xmax + ! invalid case: xmin is greater than xmax - ! type: integer(int8), kind: int8 - ! valid test case - call check(clip(2_int8, -2_int8, 5_int8) == 2_int8, & - 'clip_int8 failed for valid case', warn=.true.) - call check(clip(127_int8, -127_int8, 0_int8) == 0_int8, & - 'clip_int8 failed for valid case', warn=.true.) - ! invalid test case - call check(clip(2_int8, 5_int8, -2_int8) == 5_int8, & - 'clip_int8 failed for invalid case', warn=.true.) - call check(clip(127_int8, 0_int8, -127_int8) == 0_int8, & - 'clip_int8 failed for invalid case', warn=.true.) + ! type: integer(int8), kind: int8 + ! valid test case + call check(clip(2_int8, -2_int8, 5_int8) == 2_int8, & + 'clip_int8 failed for valid case', warn=.true.) + call check(clip(127_int8, -127_int8, 0_int8) == 0_int8, & + 'clip_int8 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int8, 5_int8, -2_int8) == 5_int8, & + 'clip_int8 failed for invalid case', warn=.true.) + call check(clip(127_int8, 0_int8, -127_int8) == 0_int8, & + 'clip_int8 failed for invalid case', warn=.true.) - ! type: integer(int16), kind: int16 - ! valid test case - call check(clip(2_int16, -2_int16, 5_int16) == 2_int16, & - 'clip_int16 failed for valid case', warn=.true.) - call check(clip(32767_int16, -32767_int16, 0_int16) == 0_int16, & - 'clip_int16 failed for valid case', warn=.true.) - ! invalid test case - call check(clip(2_int16, 5_int16, -2_int16) == 5_int16, & - 'clip_int16 failed for invalid case', warn=.true.) - call check(clip(32767_int16, 0_int16, -32767_int16) == 0_int16, & - 'clip_int16 failed for invalid case', warn=.true.) + ! type: integer(int16), kind: int16 + ! valid test case + call check(clip(2_int16, -2_int16, 5_int16) == 2_int16, & + 'clip_int16 failed for valid case', warn=.true.) + call check(clip(32767_int16, -32767_int16, 0_int16) == 0_int16, & + 'clip_int16 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int16, 5_int16, -2_int16) == 5_int16, & + 'clip_int16 failed for invalid case', warn=.true.) + call check(clip(32767_int16, 0_int16, -32767_int16) == 0_int16, & + 'clip_int16 failed for invalid case', warn=.true.) - ! type: integer(int32), kind: int32 - ! valid test case - call check(clip(2_int32, -2_int32, 5_int32) == 2_int32, & - 'clip_int32 failed for valid case', warn=.true.) - call check(clip(-2147483647_int32, 0_int32, 2147483647_int32) == 0_int32, & - 'clip_int32 failed for valid case', warn=.true.) - ! invalid test case - call check(clip(2_int32, 5_int32, -2_int32) == 5_int32, & - 'clip_int32 failed for invalid case', warn=.true.) - call check(clip(-2147483647_int32, 2147483647_int32, 0_int32) == 2147483647_int32, & - 'clip_int32 failed for invalid case', warn=.true.) + ! type: integer(int32), kind: int32 + ! valid test case + call check(clip(2_int32, -2_int32, 5_int32) == 2_int32, & + 'clip_int32 failed for valid case', warn=.true.) + call check(clip(-2147483647_int32, 0_int32, 2147483647_int32) == 0_int32, & + 'clip_int32 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int32, 5_int32, -2_int32) == 5_int32, & + 'clip_int32 failed for invalid case', warn=.true.) + call check(clip(-2147483647_int32, 2147483647_int32, 0_int32) == 2147483647_int32, & + 'clip_int32 failed for invalid case', warn=.true.) - ! type: integer(int64), kind: int64 - ! valid test case - call check(clip(2_int64, -2_int64, 5_int64) == 2_int64, & - 'clip_int64 failed for valid case', warn=.true.) - call check(clip(-922337203_int64, -10_int64, 25_int64) == -10_int64, & - 'clip_int64 failed for valid case', warn=.true.) - ! invalid test case - call check(clip(2_int64, 5_int64, -2_int64) == 5_int64, & - 'clip_int64 failed for invalid case', warn=.true.) - call check(clip(-922337203_int64, 25_int64, -10_int64) == 25_int64, & - 'clip_int64 failed for invalid case', warn=.true.) + ! type: integer(int64), kind: int64 + ! valid test case + call check(clip(2_int64, -2_int64, 5_int64) == 2_int64, & + 'clip_int64 failed for valid case', warn=.true.) + call check(clip(-922337203_int64, -10_int64, 25_int64) == -10_int64, & + 'clip_int64 failed for valid case', warn=.true.) + ! invalid test case + call check(clip(2_int64, 5_int64, -2_int64) == 5_int64, & + 'clip_int64 failed for invalid case', warn=.true.) + call check(clip(-922337203_int64, 25_int64, -10_int64) == 25_int64, & + 'clip_int64 failed for invalid case', warn=.true.) - ! type: real(sp), kind: sp - ! valid test case - call check(clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp, & - 'clip_sp failed for valid case', warn=.true.) - call check(clip(0.0_sp, -1578.025_sp, -59.68_sp) == -59.68_sp, & - 'clip_sp failed for valid case', warn=.true.) - ! invalid test case - call check(clip(3.025_sp, 3.025_sp, -5.77_sp) == 3.025_sp, & - 'clip_sp failed for invalid case', warn=.true.) - call check(clip(0.0_sp, -59.68_sp, -1578.025_sp) == -59.68_sp, & - 'clip_sp failed for invalid case', warn=.true.) + ! type: real(sp), kind: sp + ! valid test case + call check(clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp, & + 'clip_sp failed for valid case', warn=.true.) + call check(clip(0.0_sp, -1578.025_sp, -59.68_sp) == -59.68_sp, & + 'clip_sp failed for valid case', warn=.true.) + ! invalid test case + call check(clip(3.025_sp, 3.025_sp, -5.77_sp) == 3.025_sp, & + 'clip_sp failed for invalid case', warn=.true.) + call check(clip(0.0_sp, -59.68_sp, -1578.025_sp) == -59.68_sp, & + 'clip_sp failed for invalid case', warn=.true.) - ! type: real(dp), kind: dp - ! valid test case - call check(clip(3.025_dp, -5.77_dp, 3.025_dp) == 3.025_dp, & - 'clip_dp failed for valid case', warn=.true.) - call check(clip(-7.0_dp, 0.059668_dp, 1.00268_dp) == 0.059668_dp, & - 'clip_dp failed for valid case', warn=.true.) - ! invalid test case - call check(clip(3.025_dp, 3.025_dp, -5.77_dp) == 3.025_dp, & - 'clip_dp failed for invalid case', warn=.true.) - call check(clip(-7.0_dp, 1.00268_dp, 0.059668_dp) == 1.00268_dp, & - 'clip_dp failed for invalid case', warn=.true.) + ! type: real(dp), kind: dp + ! valid test case + call check(clip(3.025_dp, -5.77_dp, 3.025_dp) == 3.025_dp, & + 'clip_dp failed for valid case', warn=.true.) + call check(clip(-7.0_dp, 0.059668_dp, 1.00268_dp) == 0.059668_dp, & + 'clip_dp failed for valid case', warn=.true.) + ! invalid test case + call check(clip(3.025_dp, 3.025_dp, -5.77_dp) == 3.025_dp, & + 'clip_dp failed for invalid case', warn=.true.) + call check(clip(-7.0_dp, 1.00268_dp, 0.059668_dp) == 1.00268_dp, & + 'clip_dp failed for invalid case', warn=.true.) - ! type: real(qp), kind: qp - ! valid test case - call check(clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp, & - 'clip_qp failed for valid case', warn=.true.) - call check(clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp) == -689712245.23_qp, & - 'clip_qp failed for valid case', warn=.true.) - ! invalid test case - call check(clip(3.025_qp, 3.025_qp, -5.77_qp) == 3.025_qp, & - 'clip_qp failed for invalid case', warn=.true.) - call check(clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp) == -689712245.23_qp, & - 'clip_qp failed for invalid case', warn=.true.) + ! type: real(qp), kind: qp + ! valid test case + call check(clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp, & + 'clip_qp failed for valid case', warn=.true.) + call check(clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp) == -689712245.23_qp, & + 'clip_qp failed for valid case', warn=.true.) + ! invalid test case + call check(clip(3.025_qp, 3.025_qp, -5.77_qp) == 3.025_qp, & + 'clip_qp failed for invalid case', warn=.true.) + call check(clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp) == -689712245.23_qp, & + 'clip_qp failed for invalid case', warn=.true.) -end program tester +end program test_stdlib_math