gcc/testsuite/gfortran.dg/coarray/ptr_comp_1.f08

   1 ! { dg-do run }
   2
   3 program alloc_comp
   4    type t
   5       integer, pointer :: z
   6    end type
   7    type(t), save :: obj[*]
   8    integer, allocatable, target :: i[:]
   9
  10    if (associated(obj%z)) error stop "'z' should not be associated yet."
  11    allocate (obj%z)
  12    call f(obj)
  13    if (associated(obj%z)) error stop "'z' should not be associated anymore."
  14
  15    allocate(i[*], SOURCE=42)
  16    obj%z => i
  17    if (.not. allocated(i)) error stop "'i' no longer allocated."
  18    i = 15
  19    if (obj%z /= 15) error stop "'obj%z' is deep copy and not pointer."
  20
  21    nullify (obj%z)
  22    if (.not. allocated(i)) error stop "'i' should still be allocated."
  23    if (associated(obj%z)) error stop "'obj%z' should not be associated anymore."
  24
  25    obj%z => i
  26    call f(obj)
  27    ! One can not say anything about i here. The memory should be deallocated, but
  28    ! the pointer in i is still set.
  29    if (associated(obj%z)) error stop "'obj%z' should not be associated anymore."
  30 contains
  31    subroutine f(x)
  32       type(t) :: x[*]
  33       if ( associated(x%z) ) deallocate(x%z)
  34    end subroutine
  35 end program
  36