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