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