gcc/testsuite/gfortran.dg/alloc_comp_assign_3.f90

   1 ! { dg-do run }
   2 ! Test assignments of nested derived types with allocatable components(PR 20541).
   3 !
   4 ! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
   5 !            and Paul Thomas  <pault@gcc.gnu.org>
   6 !
   7   type :: a
   8     integer, allocatable :: i(:)
   9   end type a
  10
  11   type :: b
  12     type (a), allocatable :: at(:)
  13   end type b
  14
  15   type(a) :: x(2)
  16   type(b) :: y(2), z(2)
  17   integer i, m(4)
  18
  19   x(1) = a((/1,2,3,4/))
  20   x(2) = a((/1,2,3,4/)+10)
  21
  22   y(1) = b((/x(1),x(2)/))
  23   y(2) = b((/x(2),x(1)/))
  24
  25   y(2) = y(1)
  26   forall (j=1:2,k=1:4, y(1)%at(j)%i(k) .ne. y(2)%at(j)%i(k)) &
  27                              y(1)%at(j)%i(k) = 999
  28   if (any ((/((y(1)%at(j)%i(k), k=1,4),j=1,2)/) .eq. 999)) call abort ()
  29
  30
  31   z = y
  32   forall (i=1:2,j=1:2,k=1:4, z(i)%at(j)%i(k) .ne. y(i)%at(j)%i(k)) &
  33                              z(i)%at(j)%i(k) = 999
  34   if (any ((/(((z(i)%at(j)%i(k), k=1,4),j=1,2),i=1,2)/) .eq. 999)) call abort ()
  35
  36 end