gcc/testsuite/gfortran.dg/intent_out_21.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/92178
   4 ! Check that in the case of a data reference depending on its own content
   5 ! passed as actual argument to an INTENT(OUT) dummy, no reference to the
   6 ! content happens after the deallocation.
   7
   8 program p
   9   implicit none
  10   type t
  11     integer :: i
  12   end type t
  13   type u
  14     class(t), allocatable :: ta(:)
  15   end type u
  16   type(u), allocatable :: c(:)
  17   c = [u([t(1), t(3)]), u([t(4), t(9)])]
  18   call bar (                          &
  19       allocated (c(c(1)%ta(1)%i)%ta), &
  20       c(c(1)%ta(1)%i)%ta,             &
  21       allocated (c(c(1)%ta(1)%i)%ta)  &
  22   )
  23   if (allocated(c(1)%ta)) stop 11
  24   if (.not. allocated(c(2)%ta)) stop 12
  25 contains
  26   subroutine bar (alloc, x, alloc2)
  27     logical :: alloc, alloc2
  28     class(t), allocatable, intent(out) :: x(:)
  29     if (allocated (x)) stop 1
  30     if (.not. alloc)   stop 2
  31     if (.not. alloc2)  stop 3
  32   end subroutine bar
  33 end