gcc/testsuite/gfortran.dg/realloc_on_assign_28.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/66102
   4 !
   5 ! Contributed by Vladimir Fuka  <vladimir.fuka@gmail.com>
   6 !
   7   type t
   8     integer,allocatable :: i
   9   end type
  10
  11   type(t) :: e
  12   type(t), allocatable, dimension(:) :: a, b
  13   integer :: chksum = 0
  14
  15   do i=1,3   ! Was 100 in original
  16     e%i = i
  17     chksum = chksum + i
  18     if (.not.allocated(a)) then
  19       a = [e]
  20       b = first_arg([e], [e])
  21     else
  22       call foo
  23     end if
  24   end do
  25
  26   if (sum ([(a(i)%i, i=1,size(a))]) .ne. chksum) STOP 1
  27   if (any([(a(i)%i, i=1,size(a))] /= [(i, i=1,size(a))])) STOP 2
  28   if (size(a) /= size(b)) STOP 3
  29   if (any([(b(i)%i, i=1,size(b))] /= [(i, i=1,size(b))])) STOP 4
  30 contains
  31   subroutine foo
  32     b = first_arg([b, e], [a, e])
  33     a = [a, e]
  34   end subroutine
  35   elemental function first_arg(arg1, arg2)
  36     type(t), intent(in) :: arg1, arg2
  37     type(t)             :: first_arg
  38     first_arg = arg1
  39   end function first_arg
  40 end