1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Check for semantic errors in ALLOCATE statements
4
5
6subroutine C934()
7! If type-spec appears, it shall specify a type with which each
8! allocate-object is type compatible.
9
10  type A
11    integer i
12  end type
13
14  type, extends(A) :: B
15    real, allocatable :: x(:)
16  end type
17
18  type, extends(B) :: C
19    character(5) s
20  end type
21
22  type Unrelated
23    class(A), allocatable :: polymorph
24    type(A), allocatable :: notpolymorph
25  end type
26
27  real, allocatable :: x1, x2(:)
28  class(A), allocatable :: aa1, aa2(:)
29  class(B), pointer :: bp1, bp2(:)
30  class(C), allocatable :: ca1, ca2(:)
31  class(*), pointer :: up1, up2(:)
32  type(A), allocatable :: npaa1, npaa2(:)
33  type(B), pointer :: npbp1, npbp2(:)
34  type(C), allocatable :: npca1, npca2(:)
35  class(Unrelated), allocatable :: unrelat
36
37  allocate(real:: x1)
38  allocate(real:: x2(2))
39  allocate(real:: bp2(3)%x(5))
40  !OK, type-compatible with A
41  allocate(A:: aa1, aa2(2), up1, up2(3), &
42    unrelat%polymorph, unrelat%notpolymorph, npaa1, npaa2(4))
43  !OK, type compatible with B
44  allocate(B:: aa1, aa2(2), up1, up2(3), &
45    unrelat%polymorph, bp1, bp2(2), npbp1, npbp2(2:4))
46  !OK, type compatible with C
47  allocate(C:: aa1, aa2(2), up1, up2(3), &
48    unrelat%polymorph, bp1, bp2(2), ca1, ca2(4), &
49    npca1, npca2(2:4))
50
51
52  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
53  allocate(complex:: x1)
54  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
55  allocate(complex:: x2(2))
56  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
57  allocate(logical:: bp2(3)%x(5))
58  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
59  allocate(A:: unrelat)
60  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
61  allocate(B:: unrelat%notpolymorph)
62  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
63  allocate(B:: npaa1)
64  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
65  allocate(B:: npaa2(4))
66  !ERROR: Allocatable object in ALLOCATE must be type compatible with type-spec
67  allocate(C:: npca1, bp1, npbp1)
68end subroutine
69