Skip to content

Commit

Permalink
add tests for 1d arrays (reals, ints, logical)
Browse files Browse the repository at this point in the history
  • Loading branch information
nshaffer committed Jan 7, 2020
1 parent e06e322 commit 274a2bb
Showing 1 changed file with 139 additions and 18 deletions.
157 changes: 139 additions & 18 deletions src/tests/optval/test_optval.f90
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

0 comments on commit 274a2bb

Please sign in to comment.