gcc/testsuite/gfortran.dg/class_allocate_23.f08

   1 ! { dg-do run }
   2 !
   3 ! Test that pr78356 is fixed.
   4 ! Contributed by Janus Weil and Andrew Benson
   5
   6 program p
   7   implicit none
   8   type ac
   9   end type
  10   type, extends(ac) :: a
  11      integer, allocatable :: b
  12   end type
  13   type n
  14      class(ac), allocatable :: acr(:)
  15   end type
  16   type(n) :: s,t
  17   allocate(a :: s%acr(1))
  18   call nncp(s,t)
  19   select type (cl => t%acr(1))
  20     class is (a)
  21       if (allocated(cl%b)) error stop
  22     class default
  23       error stop
  24   end select
  25 contains
  26   subroutine nncp(self,tg)
  27     type(n) :: self, tg
  28     allocate(tg%acr(1),source=self%acr(1))
  29   end
  30 end
  31