From e06e322b45f3277cb1863e43a0d7692d0b1d2dfb Mon Sep 17 00:00:00 2001 From: Nathaniel Shaffer Date: Tue, 7 Jan 2020 06:58:14 -0700 Subject: [PATCH 1/2] add "elemental" and/or "pure" attributes where possible --- src/stdlib_experimental_optval.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/stdlib_experimental_optval.f90 b/src/stdlib_experimental_optval.f90 index 3f42fcee3..fc1cf56f5 100644 --- a/src/stdlib_experimental_optval.f90 +++ b/src/stdlib_experimental_optval.f90 @@ -34,7 +34,7 @@ module stdlib_experimental_optval contains - function optval_sp(x, default) result(y) + pure elemental function optval_sp(x, default) result(y) real(sp), intent(in), optional :: x real(sp), intent(in) :: default real(sp) :: y @@ -47,7 +47,7 @@ function optval_sp(x, default) result(y) end function optval_sp - function optval_dp(x, default) result(y) + pure elemental function optval_dp(x, default) result(y) real(dp), intent(in), optional :: x real(dp), intent(in) :: default real(dp) :: y @@ -60,7 +60,7 @@ function optval_dp(x, default) result(y) end function optval_dp - function optval_qp(x, default) result(y) + pure elemental function optval_qp(x, default) result(y) real(qp), intent(in), optional :: x real(qp), intent(in) :: default real(qp) :: y @@ -73,7 +73,7 @@ function optval_qp(x, default) result(y) end function optval_qp - function optval_int8(x, default) result(y) + pure elemental function optval_int8(x, default) result(y) integer(int8), intent(in), optional :: x integer(int8), intent(in) :: default integer(int8) :: y @@ -86,7 +86,7 @@ function optval_int8(x, default) result(y) end function optval_int8 - function optval_int16(x, default) result(y) + pure elemental function optval_int16(x, default) result(y) integer(int16), intent(in), optional :: x integer(int16), intent(in) :: default integer(int16) :: y @@ -99,7 +99,7 @@ function optval_int16(x, default) result(y) end function optval_int16 - function optval_int32(x, default) result(y) + pure elemental function optval_int32(x, default) result(y) integer(int32), intent(in), optional :: x integer(int32), intent(in) :: default integer(int32) :: y @@ -112,7 +112,7 @@ function optval_int32(x, default) result(y) end function optval_int32 - function optval_int64(x, default) result(y) + pure elemental function optval_int64(x, default) result(y) integer(int64), intent(in), optional :: x integer(int64), intent(in) :: default integer(int64) :: y @@ -125,7 +125,7 @@ function optval_int64(x, default) result(y) end function optval_int64 - function optval_logical(x, default) result(y) + pure elemental function optval_logical(x, default) result(y) logical, intent(in), optional :: x logical, intent(in) :: default logical :: y @@ -138,7 +138,7 @@ function optval_logical(x, default) result(y) end function optval_logical - function optval_character(x, default) result(y) + pure function optval_character(x, default) result(y) character(len=*), intent(in), optional :: x character(len=*), intent(in) :: default character(len=:), allocatable :: y From 274a2bbabe7fdc37f969135652aeeb7815219218 Mon Sep 17 00:00:00 2001 From: Nathaniel Shaffer Date: Tue, 7 Jan 2020 07:00:21 -0700 Subject: [PATCH 2/2] add tests for 1d arrays (reals, ints, logical) --- src/tests/optval/test_optval.f90 | 157 +++++++++++++++++++++++++++---- 1 file changed, 139 insertions(+), 18 deletions(-) diff --git a/src/tests/optval/test_optval.f90 b/src/tests/optval/test_optval.f90 index 85d9748c9..482e55ac6 100644 --- a/src/tests/optval/test_optval.f90 +++ b/src/tests/optval/test_optval.f90 @@ -20,16 +20,25 @@ program test_optval call test_optval_character + + call test_optval_sp_arr + call test_optval_dp_arr + call test_optval_qp_arr + + call test_optval_int8_arr + call test_optval_int16_arr + call test_optval_int32_arr + call test_optval_int64_arr + contains - subroutine test_optval_sp print *, "test_optval_sp" call assert(foo_sp(1.0_sp) == 1.0_sp) call assert(foo_sp() == 2.0_sp) end subroutine test_optval_sp - + function foo_sp(x) result(z) real(sp), intent(in), optional :: x real(sp) :: z @@ -43,7 +52,7 @@ subroutine test_optval_dp call assert(foo_dp() == 2.0_dp) end subroutine test_optval_dp - + function foo_dp(x) result(z) real(dp), intent(in), optional :: x real(dp) :: z @@ -57,27 +66,27 @@ subroutine test_optval_qp call assert(foo_qp() == 2.0_qp) end subroutine test_optval_qp - + function foo_qp(x) result(z) real(qp), intent(in), optional :: x real(qp) :: z z = optval(x, 2.0_qp) endfunction foo_qp - - + + subroutine test_optval_int8 print *, "test_optval_int8" call assert(foo_int8(1_int8) == 1_int8) call assert(foo_int8() == 2_int8) end subroutine test_optval_int8 - + function foo_int8(x) result(z) integer(int8), intent(in), optional :: x integer(int8) :: z z = optval(x, 2_int8) endfunction foo_int8 - + subroutine test_optval_int16 print *, "test_optval_int16" @@ -85,41 +94,41 @@ subroutine test_optval_int16 call assert(foo_int16() == 2_int16) end subroutine test_optval_int16 - + function foo_int16(x) result(z) integer(int16), intent(in), optional :: x integer(int16) :: z z = optval(x, 2_int16) endfunction foo_int16 - + subroutine test_optval_int32 print *, "test_optval_int32" call assert(foo_int32(1_int32) == 1_int32) call assert(foo_int32() == 2_int32) end subroutine test_optval_int32 - + function foo_int32(x) result(z) integer(int32), intent(in), optional :: x integer(int32) :: z z = optval(x, 2_int32) endfunction foo_int32 - + subroutine test_optval_int64 print *, "test_optval_int64" call assert(foo_int64(1_int64) == 1_int64) call assert(foo_int64() == 2_int64) end subroutine test_optval_int64 - + function foo_int64(x) result(z) integer(int64), intent(in), optional :: x integer(int64) :: z z = optval(x, 2_int64) endfunction foo_int64 - + subroutine test_optval_logical print *, "test_optval_logical" @@ -127,13 +136,13 @@ subroutine test_optval_logical call assert(.not.foo_logical()) end subroutine test_optval_logical - + function foo_logical(x) result(z) logical, intent(in), optional :: x logical :: z z = optval(x, .false.) endfunction foo_logical - + subroutine test_optval_character print *, "test_optval_character" @@ -141,11 +150,123 @@ subroutine test_optval_character call assert(foo_character() == "y") end subroutine test_optval_character - + function foo_character(x) result(z) character(len=*), intent(in), optional :: x character(len=:), allocatable :: z z = optval(x, "y") endfunction foo_character - + + + subroutine test_optval_sp_arr + print *, "test_optval_sp_arr" + call assert(all(foo_sp_arr([1.0_sp, -1.0_sp]) == [1.0_sp, -1.0_sp])) + call assert(all(foo_sp_arr() == [2.0_sp, -2.0_sp])) + end subroutine test_optval_sp_arr + + + function foo_sp_arr(x) result(z) + real(sp), dimension(2), intent(in), optional :: x + real(sp), dimension(2) :: z + z = optval(x, [2.0_sp, -2.0_sp]) + end function foo_sp_arr + + + subroutine test_optval_dp_arr + print *, "test_optval_dp_arr" + call assert(all(foo_dp_arr([1.0_dp, -1.0_dp]) == [1.0_dp, -1.0_dp])) + call assert(all(foo_dp_arr() == [2.0_dp, -2.0_dp])) + end subroutine test_optval_dp_arr + + + function foo_dp_arr(x) result(z) + real(dp), dimension(2), intent(in), optional :: x + real(dp), dimension(2) :: z + z = optval(x, [2.0_dp, -2.0_dp]) + end function foo_dp_arr + + + subroutine test_optval_qp_arr + print *, "test_optval_qp_arr" + call assert(all(foo_qp_arr([1.0_qp, -1.0_qp]) == [1.0_qp, -1.0_qp])) + call assert(all(foo_qp_arr() == [2.0_qp, -2.0_qp])) + end subroutine test_optval_qp_arr + + + function foo_qp_arr(x) result(z) + real(qp), dimension(2), intent(in), optional :: x + real(qp), dimension(2) :: z + z = optval(x, [2.0_qp, -2.0_qp]) + end function foo_qp_arr + + + subroutine test_optval_int8_arr + print *, "test_optval_int8_arr" + call assert(all(foo_int8_arr([1_int8, -1_int8]) == [1_int8, -1_int8])) + call assert(all(foo_int8_arr() == [2_int8, -2_int8])) + end subroutine test_optval_int8_arr + + + function foo_int8_arr(x) result(z) + integer(int8), dimension(2), intent(in), optional :: x + integer(int8), dimension(2) :: z + z = optval(x, [2_int8, -2_int8]) + end function foo_int8_arr + + + subroutine test_optval_int16_arr + print *, "test_optval_int16_arr" + call assert(all(foo_int16_arr([1_int16, -1_int16]) == [1_int16, -1_int16])) + call assert(all(foo_int16_arr() == [2_int16, -2_int16])) + end subroutine test_optval_int16_arr + + + function foo_int16_arr(x) result(z) + integer(int16), dimension(2), intent(in), optional :: x + integer(int16), dimension(2) :: z + z = optval(x, [2_int16, -2_int16]) + end function foo_int16_arr + + + subroutine test_optval_int32_arr + print *, "test_optval_int32_arr" + call assert(all(foo_int32_arr([1_int32, -1_int32]) == [1_int32, -1_int32])) + call assert(all(foo_int32_arr() == [2_int32, -2_int32])) + end subroutine test_optval_int32_arr + + + function foo_int32_arr(x) result(z) + integer(int32), dimension(2), intent(in), optional :: x + integer(int32), dimension(2) :: z + z = optval(x, [2_int32, -2_int32]) + end function foo_int32_arr + + + subroutine test_optval_int64_arr + print *, "test_optval_int64_arr" + call assert(all(foo_int64_arr([1_int64, -1_int64]) == [1_int64, -1_int64])) + call assert(all(foo_int64_arr() == [2_int64, -2_int64])) + end subroutine test_optval_int64_arr + + + function foo_int64_arr(x) result(z) + integer(int64), dimension(2), intent(in), optional :: x + integer(int64), dimension(2) :: z + z = optval(x, [2_int64, -2_int64]) + end function foo_int64_arr + + + subroutine test_optval_logical_arr + print *, "test_optval_logical_arr" + call assert(all(foo_logical_arr())) + call assert(all(.not.foo_logical_arr())) + end subroutine test_optval_logical_arr + + + function foo_logical_arr(x) result(z) + logical, dimension(2), intent(in), optional :: x + logical, dimension(2) :: z + z = optval(x, [.false., .false.]) + end function foo_logical_arr + end program test_optval