Skip to content

Commit

Permalink
Add tests for empty and complete index list
Browse files Browse the repository at this point in the history
  • Loading branch information
awvwgk committed Dec 20, 2021
1 parent ae608ee commit 7b5ffac
Show file tree
Hide file tree
Showing 2 changed files with 94 additions and 0 deletions.
8 changes: 8 additions & 0 deletions doc/specs/stdlib_array.md
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,10 @@ Turn a logical mask into an index array by selecting all true values.

`lbound`: Lower bound of the array to index. This argument is `optional` and `intent(in)`.

#### Return value

Returns an array of default integer size, with a maximum length of `size(array)` elements.

#### Examples

```fortran
Expand Down Expand Up @@ -67,6 +71,10 @@ Turn a logical mask into an index array by selecting all false values.

`lbound`: Lower bound of the array to index. This argument is `optional` and `intent(in)`.

#### Return value

Returns an array of default integer size, with a maximum length of `size(array)` elements.

#### Examples

```fortran
Expand Down
86 changes: 86 additions & 0 deletions src/tests/array/test_logicalloc.f90
Original file line number Diff line number Diff line change
Expand Up @@ -17,13 +17,58 @@ subroutine collect_logicalloc(testsuite)
type(unittest_type), allocatable, intent(out) :: testsuite(:)

testsuite = [ &
new_unittest("trueloc-empty", test_trueloc_empty), &
new_unittest("trueloc-all", test_trueloc_all), &
new_unittest("trueloc-where", test_trueloc_where), &
new_unittest("trueloc-merge", test_trueloc_merge), &
new_unittest("falseloc-empty", test_falseloc_empty), &
new_unittest("falseloc-all", test_falseloc_all), &
new_unittest("falseloc-where", test_falseloc_where), &
new_unittest("falseloc-merge", test_falseloc_merge) &
]
end subroutine collect_logicalloc

subroutine test_trueloc_empty(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: ndim
real, allocatable :: avec(:), bvec(:)

do ndim = 100, 12000, 100
allocate(avec(ndim))

call random_number(avec)

bvec = avec
bvec(trueloc(bvec < 0)) = 0.0

call check(error, all(bvec == avec))
deallocate(avec, bvec)
if (allocated(error)) exit
end do
end subroutine test_trueloc_empty

subroutine test_trueloc_all(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: ndim
real, allocatable :: avec(:)

do ndim = 100, 12000, 100
allocate(avec(-ndim/2:ndim))

call random_number(avec)

avec(trueloc(avec > 0, lbound(avec, 1))) = 0.0

call check(error, all(avec == 0.0))
deallocate(avec)
if (allocated(error)) exit
end do
end subroutine test_trueloc_all

subroutine test_trueloc_where(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
Expand Down Expand Up @@ -74,6 +119,47 @@ subroutine test_trueloc_merge(error)
end do
end subroutine test_trueloc_merge

subroutine test_falseloc_empty(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: ndim
real, allocatable :: avec(:), bvec(:)

do ndim = 100, 12000, 100
allocate(avec(ndim))

call random_number(avec)

bvec = avec
bvec(falseloc(bvec > 0)) = 0.0

call check(error, all(bvec == avec))
deallocate(avec, bvec)
if (allocated(error)) exit
end do
end subroutine test_falseloc_empty

subroutine test_falseloc_all(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: ndim
real, allocatable :: avec(:)

do ndim = 100, 12000, 100
allocate(avec(-ndim/2:ndim))

call random_number(avec)

avec(falseloc(avec < 0, lbound(avec, 1))) = 0.0

call check(error, all(avec == 0.0))
deallocate(avec)
if (allocated(error)) exit
end do
end subroutine test_falseloc_all

subroutine test_falseloc_where(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
Expand Down

0 comments on commit 7b5ffac

Please sign in to comment.