Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make optval pure or pure elemental where possible #96

Merged
merged 3 commits into from
Jan 7, 2020
Merged

Make optval pure or pure elemental where possible #96

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
e06e322
add "elemental" and/or "pure" attributes where possible
nshaffer Jan 7, 2020
274a2bb
add tests for 1d arrays (reals, ints, logical)
nshaffer Jan 7, 2020
f857482
Merge branch 'master' into dev-optval
certik Jan 7, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 8 additions & 8 deletions src/stdlib_experimental_optval.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ module stdlib_experimental_optval
contains


pure 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
Expand All @@ -47,7 +47,7 @@ pure function optval_sp(x, default) result(y)
end function optval_sp


pure 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
Expand All @@ -60,7 +60,7 @@ pure function optval_dp(x, default) result(y)
end function optval_dp


pure 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
Expand All @@ -73,7 +73,7 @@ pure function optval_qp(x, default) result(y)
end function optval_qp


pure 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
Expand All @@ -86,7 +86,7 @@ pure function optval_int8(x, default) result(y)
end function optval_int8


pure 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
Expand All @@ -99,7 +99,7 @@ pure function optval_int16(x, default) result(y)
end function optval_int16


pure 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
Expand All @@ -112,7 +112,7 @@ pure function optval_int32(x, default) result(y)
end function optval_int32


pure 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
Expand All @@ -125,7 +125,7 @@ pure function optval_int64(x, default) result(y)
end function optval_int64


pure 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
Expand Down
157 changes: 139 additions & 18 deletions src/tests/optval/test_optval.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -57,95 +66,207 @@ 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"
call assert(foo_int16(1_int16) == 1_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"
call assert(foo_logical(.true.))
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"
call assert(foo_character("x") == "x")
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