gcc/testsuite/gfortran.dg/class_allocate_3.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 41581: [OOP] Allocation of a CLASS with SOURCE=<class> does not work
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7  type t
   8  end type t
   9
  10  type,extends(t) :: t2
  11    integer :: i = 54
  12    real :: r = 384.02
  13  end type t2
  14
  15  class(t), allocatable :: m1, m2
  16
  17  allocate(t2 :: m2)
  18  select type(m2)
  19  type is (t2)
  20    print *, m2%i, m2%r
  21    if (m2%i/=54) call abort()
  22    if (abs(m2%r-384.02)>1E-3) call abort()
  23    m2%i = 42
  24    m2%r = -4.0
  25  class default
  26    call abort()
  27  end select
  28
  29  allocate(m1, source=m2)
  30  select type(m1)
  31  type is (t2)
  32    print *, m1%i, m1%r
  33    if (m1%i/=42) call abort()
  34    if (abs(m1%r+4.0)>1E-3) call abort()
  35  class default
  36    call abort()
  37  end select
  38
  39 end