52 lines
1.4 KiB
Fortran
52 lines
1.4 KiB
Fortran
! { dg-do run }
|
|
! Tests the implementation of 13.14.13 of the f95 standard
|
|
! in respect of zero character and zero array length.
|
|
!
|
|
! Contributed by Paul Thomas <pault@gcc.gnu.org>
|
|
!
|
|
call test1 ()
|
|
call test2 ()
|
|
call test3 (0)
|
|
call test3 (1)
|
|
contains
|
|
subroutine test1 ()
|
|
integer, pointer, dimension(:, :, :) :: a, b
|
|
allocate (a(2,0,2))
|
|
b => a
|
|
! Even though b is zero length, associated returns true because
|
|
! the target argument is not present (case (i))
|
|
if (.not. associated (b)) call abort ()
|
|
deallocate (a)
|
|
nullify(a)
|
|
if(associated(a,a)) call abort()
|
|
allocate (a(2,1,2))
|
|
b => a
|
|
if (.not.associated (b)) call abort ()
|
|
deallocate (a)
|
|
end subroutine test1
|
|
subroutine test2 ()
|
|
integer, pointer, dimension(:, :, :) :: a, b
|
|
allocate (a(2,0,2))
|
|
b => a
|
|
! Associated returns false because target is present (case(iii)).
|
|
if (associated (b, a)) call abort ()
|
|
deallocate (a)
|
|
allocate (a(2,1,2))
|
|
b => a
|
|
if (.not.associated (b, a)) call abort ()
|
|
deallocate (a)
|
|
end subroutine test2
|
|
subroutine test3 (n)
|
|
integer :: n
|
|
character(len=n), pointer, dimension(:) :: a, b
|
|
allocate (a(2))
|
|
b => a
|
|
! Again, with zero character length associated returns false
|
|
! if target is present.
|
|
if (associated (b, a) .and. (n .eq. 0)) call abort ()
|
|
!
|
|
if ((.not.associated (b, a)) .and. (n .ne. 0)) call abort ()
|
|
deallocate (a)
|
|
end subroutine test3
|
|
end
|