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