1! { dg-do run } 2! 3! Check that allocate with source for arrays without array-spec 4! works. 5! PR fortran/44672 6! Contributed by Tobias Burnus <burnus@gcc.gnu.org> 7! Antony Lewis <antony@cosmologist.info> 8! Andre Vehreschild <vehre@gcc.gnu.org> 9! 10 11program allocate_with_source_6 12 13 type P 14 class(*), allocatable :: X(:,:) 15 end type 16 17 type t 18 end type t 19 20 type(t), allocatable :: a(:), b, c(:) 21 integer :: num_params_used = 6 22 integer, allocatable :: m(:) 23 24 allocate(b,c(5)) 25 allocate(a(5), source=b) 26 deallocate(a) 27 allocate(a, source=c) 28 allocate(m, source=[(I, I=1, num_params_used)]) 29 if (any(m /= [(I, I=1, num_params_used)])) STOP 1 30 deallocate(a,b,m) 31 call testArrays() 32 33contains 34 subroutine testArrays() 35 type L 36 class(*), allocatable :: v(:) 37 end type 38 Type(P) Y 39 type(L) o 40 real arr(3,5) 41 real, allocatable :: v(:) 42 43 arr = 5 44 allocate(Y%X, source=arr) 45 select type (R => Y%X) 46 type is (real) 47 if (any(reshape(R, [15]) /= [5,5,5,5,5, 5,5,5,5,5, 5,5,5,5,5])) & 48 STOP 2 49 class default 50 STOP 3 51 end select 52 deallocate(Y%X) 53 54 allocate(Y%X, source=arr(2:3,3:4)) 55 select type (R => Y%X) 56 type is (real) 57 if (any(reshape(R, [4]) /= [5,5,5,5])) & 58 STOP 4 59 class default 60 STOP 5 61 end select 62 deallocate(Y%X) 63 64 allocate(o%v, source=arr(2,3:4)) 65 select type (R => o%v) 66 type is (real) 67 if (any(R /= [5,5])) & 68 STOP 6 69 class default 70 STOP 7 71 end select 72 deallocate(o%v) 73 74 allocate(v, source=arr(2,1:5)) 75 if (any(v /= [5,5,5,5,5])) STOP 8 76 deallocate(v) 77 end subroutine testArrays 78end 79 80