gcc/testsuite/gfortran.dg/allocate_with_source_22.f03

   1 ! { dg-do run }
   2 !
   3 ! Test that pr72832 is fixed now.
   4 ! Contributed by Daan van Vugt
   5
   6 program allocate_source
   7   type :: t
   8     integer :: i
   9   end type t
  10   type, extends(t) :: tt
  11   end type tt
  12
  13   call test_type()
  14   call test_class()
  15
  16 contains
  17
  18 subroutine test_class()
  19   class(t), allocatable, dimension(:) :: a, b
  20   allocate(tt::a(1:2))
  21   a(:)%i = [ 1,2 ]
  22   if (size(a) /= 2) call abort()
  23   if (any(a(:)%i /= [ 1,2])) call abort()
  24
  25   allocate(b(1:4), source=a)
  26   ! b is incorrectly initialized here.  This only is diagnosed when compiled
  27   ! with -fcheck=bounds.
  28   if (size(b) /= 4) call abort()
  29   if (any(b(1:2)%i /= [ 1,2])) call abort()
  30   select type (b(1))
  31     class is (tt)
  32       continue
  33     class default
  34       call abort()
  35   end select
  36 end subroutine
  37
  38 subroutine test_type()
  39   type(t), allocatable, dimension(:) :: a, b
  40   allocate(a(1:2))
  41   if (size(a) /= 2) call abort()
  42
  43   allocate(b(1:4), source=a)
  44   if (size(b) /= 4) call abort()
  45 end subroutine
  46 end program allocate_source
  47
  48