gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03

   1 ! { dg-do run }
   2 !
   3 ! Check fix for correctly deep copying allocatable components.
   4 ! PR fortran/59678
   5 ! Contributed by Andre Vehreschild  <vehre@gmx.de>
   6 !
   7 program alloc_comp_copy_test
   8
   9   type InnerT
  10     integer :: ii
  11     integer, allocatable :: ai
  12     integer, allocatable :: v(:)
  13   end type InnerT
  14
  15   type T
  16     integer :: i
  17     integer, allocatable :: a_i
  18     type(InnerT), allocatable :: it
  19     type(InnerT), allocatable :: vec(:)
  20   end type T
  21
  22   type(T) :: o1, o2
  23   class(T), allocatable :: o3, o4
  24   o1%i = 42
  25
  26   call copyO(o1, o2)
  27   if (o2%i /= 42) call abort ()
  28   if (allocated(o2%a_i)) call abort()
  29   if (allocated(o2%it)) call abort()
  30   if (allocated(o2%vec)) call abort()
  31
  32   allocate (o1%a_i, source=2)
  33   call copyO(o1, o2)
  34   if (o2%i /= 42) call abort ()
  35   if (.not. allocated(o2%a_i)) call abort()
  36   if (o2%a_i /= 2) call abort()
  37   if (allocated(o2%it)) call abort()
  38   if (allocated(o2%vec)) call abort()
  39
  40   allocate (o1%it)
  41   o1%it%ii = 3
  42   call copyO(o1, o2)
  43   if (o2%i /= 42) call abort ()
  44   if (.not. allocated(o2%a_i)) call abort()
  45   if (o2%a_i /= 2) call abort()
  46   if (.not. allocated(o2%it)) call abort()
  47   if (o2%it%ii /= 3) call abort()
  48   if (allocated(o2%it%ai)) call abort()
  49   if (allocated(o2%it%v)) call abort()
  50   if (allocated(o2%vec)) call abort()
  51
  52   allocate (o1%it%ai)
  53   o1%it%ai = 4
  54   call copyO(o1, o2)
  55   if (o2%i /= 42) call abort ()
  56   if (.not. allocated(o2%a_i)) call abort()
  57   if (o2%a_i /= 2) call abort()
  58   if (.not. allocated(o2%it)) call abort()
  59   if (o2%it%ii /= 3) call abort()
  60   if (.not. allocated(o2%it%ai)) call abort()
  61   if (o2%it%ai /= 4) call abort()
  62   if (allocated(o2%it%v)) call abort()
  63   if (allocated(o2%vec)) call abort()
  64
  65   allocate (o1%it%v(3), source= 5)
  66   call copyO(o1, o2)
  67   if (o2%i /= 42) call abort ()
  68   if (.not. allocated(o2%a_i)) call abort()
  69   if (o2%a_i /= 2) call abort()
  70   if (.not. allocated(o2%it)) call abort()
  71   if (o2%it%ii /= 3) call abort()
  72   if (.not. allocated(o2%it%ai)) call abort()
  73   if (o2%it%ai /= 4) call abort()
  74   if (.not. allocated(o2%it%v)) call abort()
  75   if (any (o2%it%v /= 5) .or. size (o2%it%v) /= 3) call abort()
  76   if (allocated(o2%vec)) call abort()
  77
  78   allocate (o1%vec(2))
  79   o1%vec(:)%ii = 6
  80   call copyO(o1, o2)
  81   if (o2%i /= 42) call abort ()
  82   if (.not. allocated(o2%a_i)) call abort()
  83   if (o2%a_i /= 2) call abort()
  84   if (.not. allocated(o2%it)) call abort()
  85   if (o2%it%ii /= 3) call abort()
  86   if (.not. allocated(o2%it%ai)) call abort()
  87   if (o2%it%ai /= 4) call abort()
  88   if (.not. allocated(o2%it%v)) call abort()
  89   if (size (o2%it%v) /= 3) call abort()
  90   if (any (o2%it%v /= 5)) call abort()
  91   if (.not. allocated(o2%vec)) call abort()
  92   if (size(o2%vec) /= 2) call abort()
  93   if (any(o2%vec(:)%ii /= 6)) call abort()
  94   if (allocated(o2%vec(1)%ai) .or. allocated(o2%vec(2)%ai)) call abort()
  95   if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
  96
  97   allocate (o1%vec(2)%ai)
  98   o1%vec(2)%ai = 7
  99   call copyO(o1, o2)
 100   if (o2%i /= 42) call abort ()
 101   if (.not. allocated(o2%a_i)) call abort()
 102   if (o2%a_i /= 2) call abort()
 103   if (.not. allocated(o2%it)) call abort()
 104   if (o2%it%ii /= 3) call abort()
 105   if (.not. allocated(o2%it%ai)) call abort()
 106   if (o2%it%ai /= 4) call abort()
 107   if (.not. allocated(o2%it%v)) call abort()
 108   if (size (o2%it%v) /= 3) call abort()
 109   if (any (o2%it%v /= 5)) call abort()
 110   if (.not. allocated(o2%vec)) call abort()
 111   if (size(o2%vec) /= 2) call abort()
 112   if (any(o2%vec(:)%ii /= 6)) call abort()
 113   if (allocated(o2%vec(1)%ai)) call abort()
 114   if (.not. allocated(o2%vec(2)%ai)) call abort()
 115   if (o2%vec(2)%ai /= 7) call abort()
 116   if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
 117
 118   allocate (o1%vec(1)%v(3))
 119   o1%vec(1)%v = [8, 9, 10]
 120   call copyO(o1, o2)
 121   if (o2%i /= 42) call abort ()
 122   if (.not. allocated(o2%a_i)) call abort()
 123   if (o2%a_i /= 2) call abort()
 124   if (.not. allocated(o2%it)) call abort()
 125   if (o2%it%ii /= 3) call abort()
 126   if (.not. allocated(o2%it%ai)) call abort()
 127   if (o2%it%ai /= 4) call abort()
 128   if (.not. allocated(o2%it%v)) call abort()
 129   if (size (o2%it%v) /= 3) call abort()
 130   if (any (o2%it%v /= 5)) call abort()
 131   if (.not. allocated(o2%vec)) call abort()
 132   if (size(o2%vec) /= 2) call abort()
 133   if (any(o2%vec(:)%ii /= 6)) call abort()
 134   if (allocated(o2%vec(1)%ai)) call abort()
 135   if (.not. allocated(o2%vec(2)%ai)) call abort()
 136   if (o2%vec(2)%ai /= 7) call abort()
 137   if (.not. allocated(o2%vec(1)%v)) call abort()
 138   if (any (o2%vec(1)%v /= [8,9,10])) call abort()
 139   if (allocated(o2%vec(2)%v)) call abort()
 140
 141   ! Now all the above for class objects.
 142   allocate (o3, o4)
 143   o3%i = 42
 144
 145   call copyO(o3, o4)
 146   if (o4%i /= 42) call abort ()
 147   if (allocated(o4%a_i)) call abort()
 148   if (allocated(o4%it)) call abort()
 149   if (allocated(o4%vec)) call abort()
 150
 151   allocate (o3%a_i, source=2)
 152   call copyO(o3, o4)
 153   if (o4%i /= 42) call abort ()
 154   if (.not. allocated(o4%a_i)) call abort()
 155   if (o4%a_i /= 2) call abort()
 156   if (allocated(o4%it)) call abort()
 157   if (allocated(o4%vec)) call abort()
 158
 159   allocate (o3%it)
 160   o3%it%ii = 3
 161   call copyO(o3, o4)
 162   if (o4%i /= 42) call abort ()
 163   if (.not. allocated(o4%a_i)) call abort()
 164   if (o4%a_i /= 2) call abort()
 165   if (.not. allocated(o4%it)) call abort()
 166   if (o4%it%ii /= 3) call abort()
 167   if (allocated(o4%it%ai)) call abort()
 168   if (allocated(o4%it%v)) call abort()
 169   if (allocated(o4%vec)) call abort()
 170
 171   allocate (o3%it%ai)
 172   o3%it%ai = 4
 173   call copyO(o3, o4)
 174   if (o4%i /= 42) call abort ()
 175   if (.not. allocated(o4%a_i)) call abort()
 176   if (o4%a_i /= 2) call abort()
 177   if (.not. allocated(o4%it)) call abort()
 178   if (o4%it%ii /= 3) call abort()
 179   if (.not. allocated(o4%it%ai)) call abort()
 180   if (o4%it%ai /= 4) call abort()
 181   if (allocated(o4%it%v)) call abort()
 182   if (allocated(o4%vec)) call abort()
 183
 184   allocate (o3%it%v(3), source= 5)
 185   call copyO(o3, o4)
 186   if (o4%i /= 42) call abort ()
 187   if (.not. allocated(o4%a_i)) call abort()
 188   if (o4%a_i /= 2) call abort()
 189   if (.not. allocated(o4%it)) call abort()
 190   if (o4%it%ii /= 3) call abort()
 191   if (.not. allocated(o4%it%ai)) call abort()
 192   if (o4%it%ai /= 4) call abort()
 193   if (.not. allocated(o4%it%v)) call abort()
 194   if (any (o4%it%v /= 5) .or. size (o4%it%v) /= 3) call abort()
 195   if (allocated(o4%vec)) call abort()
 196
 197   allocate (o3%vec(2))
 198   o3%vec(:)%ii = 6
 199   call copyO(o3, o4)
 200   if (o4%i /= 42) call abort ()
 201   if (.not. allocated(o4%a_i)) call abort()
 202   if (o4%a_i /= 2) call abort()
 203   if (.not. allocated(o4%it)) call abort()
 204   if (o4%it%ii /= 3) call abort()
 205   if (.not. allocated(o4%it%ai)) call abort()
 206   if (o4%it%ai /= 4) call abort()
 207   if (.not. allocated(o4%it%v)) call abort()
 208   if (size (o4%it%v) /= 3) call abort()
 209   if (any (o4%it%v /= 5)) call abort()
 210   if (.not. allocated(o4%vec)) call abort()
 211   if (size(o4%vec) /= 2) call abort()
 212   if (any(o4%vec(:)%ii /= 6)) call abort()
 213   if (allocated(o4%vec(1)%ai) .or. allocated(o4%vec(2)%ai)) call abort()
 214   if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
 215
 216   allocate (o3%vec(2)%ai)
 217   o3%vec(2)%ai = 7
 218   call copyO(o3, o4)
 219   if (o4%i /= 42) call abort ()
 220   if (.not. allocated(o4%a_i)) call abort()
 221   if (o4%a_i /= 2) call abort()
 222   if (.not. allocated(o4%it)) call abort()
 223   if (o4%it%ii /= 3) call abort()
 224   if (.not. allocated(o4%it%ai)) call abort()
 225   if (o4%it%ai /= 4) call abort()
 226   if (.not. allocated(o4%it%v)) call abort()
 227   if (size (o4%it%v) /= 3) call abort()
 228   if (any (o4%it%v /= 5)) call abort()
 229   if (.not. allocated(o4%vec)) call abort()
 230   if (size(o4%vec) /= 2) call abort()
 231   if (any(o4%vec(:)%ii /= 6)) call abort()
 232   if (allocated(o4%vec(1)%ai)) call abort()
 233   if (.not. allocated(o4%vec(2)%ai)) call abort()
 234   if (o4%vec(2)%ai /= 7) call abort()
 235   if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
 236
 237   allocate (o3%vec(1)%v(3))
 238   o3%vec(1)%v = [8, 9, 10]
 239   call copyO(o3, o4)
 240   if (o4%i /= 42) call abort ()
 241   if (.not. allocated(o4%a_i)) call abort()
 242   if (o4%a_i /= 2) call abort()
 243   if (.not. allocated(o4%it)) call abort()
 244   if (o4%it%ii /= 3) call abort()
 245   if (.not. allocated(o4%it%ai)) call abort()
 246   if (o4%it%ai /= 4) call abort()
 247   if (.not. allocated(o4%it%v)) call abort()
 248   if (size (o4%it%v) /= 3) call abort()
 249   if (any (o4%it%v /= 5)) call abort()
 250   if (.not. allocated(o4%vec)) call abort()
 251   if (size(o4%vec) /= 2) call abort()
 252   if (any(o4%vec(:)%ii /= 6)) call abort()
 253   if (allocated(o4%vec(1)%ai)) call abort()
 254   if (.not. allocated(o4%vec(2)%ai)) call abort()
 255   if (o4%vec(2)%ai /= 7) call abort()
 256   if (.not. allocated(o4%vec(1)%v)) call abort()
 257   if (any (o4%vec(1)%v /= [8,9,10])) call abort()
 258   if (allocated(o4%vec(2)%v)) call abort()
 259
 260 contains
 261
 262   subroutine copyO(src, dst)
 263     type(T), intent(in) :: src
 264     type(T), intent(out) :: dst
 265
 266     dst = src
 267   end subroutine copyO
 268
 269 end program alloc_comp_copy_test
 270