gcc/testsuite/gfortran.dg/class_allocate_6.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 46174: [OOP] ALLOCATE with SOURCE: Deep copy missing
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7 implicit none
   8 type t
   9 end type t
  10
  11 type, extends(t) :: t2
  12   integer, allocatable :: a(:)
  13 end type t2
  14
  15 class(t), allocatable :: x, y
  16 integer :: i
  17
  18 allocate(t2 :: x)
  19 select type(x)
  20  type is (t2)
  21    allocate(x%a(10))
  22    x%a = [ (i, i = 1,10) ]
  23    print '(*(i3))', x%a
  24  class default
  25    STOP 1
  26 end select
  27
  28 allocate(y, source=x)
  29
  30 select type(x)
  31  type is (t2)
  32    x%a = [ (i, i = 11,20) ]
  33    print '(*(i3))', x%a
  34  class default
  35    STOP 2
  36 end select
  37
  38 select type(y)
  39  type is (t2)
  40    print '(*(i3))', y%a
  41    if (any (y%a /= [ (i, i = 1,10) ])) STOP 3
  42  class default
  43    STOP 4
  44 end select
  45
  46 end