gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR40440, in which gfortran tried to deallocate
   3 ! the allocatable components of the actual argument of CALL SUB
   4 !
   5 ! Contributed by Juergen Reuter <juergen.reuter@desy.de>
   6 ! Reduced testcase from Tobias Burnus  <burnus@gcc.gnu.org>
   7 !
   8   implicit none
   9   type t
  10     integer, allocatable :: A(:)
  11   end type t
  12   type (t) :: arg
  13   arg = t ([1,2,3])
  14   call sub (func (arg))
  15 contains
  16   function func (a)
  17     type(t), pointer :: func
  18     type(t), target :: a
  19     integer, save :: i = 0
  20     if (i /= 0) call abort ! multiple calls would cause this abort
  21     i = i + 1
  22     func => a
  23   end function func
  24   subroutine sub (a)
  25     type(t), intent(IN), target :: a
  26     if (any (a%A .ne. [1,2,3])) call abort
  27   end subroutine sub
  28 end