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) STOP 1 23 if (any(a(:)%i /= [ 1,2])) STOP 2 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) STOP 3 29 if (any(b(1:2)%i /= [ 1,2])) STOP 4 30 select type (b1 => b(1)) 31 class is (tt) 32 continue 33 class default 34 STOP 5 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) STOP 6 42 43 allocate(b(1:4), source=a) 44 if (size(b) /= 4) STOP 7 45end subroutine 46end program allocate_source 47 48 49