gcc/testsuite/gfortran.dg/intent_out_22.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/110618
   4 ! Check that if a data reference is passed as actual argument whose dummy
   5 ! has INTENT(OUT) attribute, any other argument depending on the
   6 ! same data reference is evaluated before the data reference 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   class(t), allocatable :: d(:)
  18   allocate(c, source = [u([t(1), t(3)]), u([t(4), t(9)])])
  19   allocate(d, source = [t(1), t(5)])
  20   call bar (                   &
  21       allocated(c(d(1)%i)%ta), &
  22       d,                       &
  23       c(d(1)%i)%ta,            &
  24       allocated (c(d(1)%i)%ta) &
  25   )
  26   if (allocated (c(1)%ta)) stop 11
  27   if (.not. allocated (c(2)%ta)) stop 11
  28 contains
  29   subroutine bar (alloc, x, y, alloc2)
  30     logical :: alloc, alloc2
  31     class(t), allocatable, intent(out) :: x(:)
  32     class(t), allocatable, intent(out) :: y(:)
  33     if (allocated (x)) stop 1
  34     if (.not. alloc)   stop 2
  35     if (.not. alloc2)  stop 3
  36   end subroutine bar
  37 end