1! { dg-do run } 2! 3! Test that pr72832 is fixed now. 4! Contributed by Daan van Vugt 5 6program 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 16contains 17 18subroutine 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 36end subroutine 37 38subroutine 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() 45end subroutine 46end program allocate_source 47 48 49