1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Check for semantic errors in ALLOCATE statements
4
5
6subroutine C933_b(n)
7! If any allocate-object has a deferred type parameter, is unlimited polymorphic,
8! or is of abstract type, either type-spec or source-expr shall appear.
9
10! only testing unlimited polymorphic and abstract-type here
11
12  type, abstract :: Base
13    integer x
14  end type
15
16  type, extends(Base) :: A
17    integer y
18  end type
19
20  type, extends(Base) :: B
21    class(Base), allocatable :: y
22  end type
23
24  type C
25    class(*), pointer :: whatever
26    real, pointer :: y
27  end type
28
29  integer n
30  class(*), allocatable :: u1, u2(:)
31  class(C), allocatable :: n1, n2(:)
32  class(Base), pointer :: p1, p2(:)
33  class(B), pointer :: p3, p4(:)
34  type(A) :: molda = A(1, 2)
35
36  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
37  allocate(u1)
38  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
39  allocate(u2(2))
40  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
41  allocate(n1%whatever)
42  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is unlimited polymorphic
43  allocate(n2(2)%whatever)
44  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
45  allocate(p1)
46  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
47  allocate(p2(2))
48  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
49  allocate(p3%y)
50  !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object is of abstract type
51  allocate(p4(2)%y)
52  !WRONG allocate(Base:: u1)
53
54  ! No error expected
55  allocate(real:: u1, u2(2))
56  allocate(A:: u1, u2(2))
57  allocate(C:: u1, u2(2))
58  allocate(character(n):: u1, u2(2))
59  allocate(C:: n1%whatever, n2(2)%whatever)
60  allocate(A:: p1, p2(2))
61  allocate(B:: p3%y, p4(2)%y)
62  allocate(u1, u2(2), MOLD = cos(5.+n))
63  allocate(u1, u2(2), MOLD = molda)
64  allocate(u1, u2(2), MOLD = n1)
65  allocate(u1, u2(2), MOLD = new_line("a"))
66  allocate(n1%whatever, MOLD = n2(1))
67  allocate(p1, p2(2), MOLD = p3)
68  allocate(p3%y, p4(2)%y, MOLD = B(5))
69  allocate(u1, u2(2), SOURCE = cos(5.+n))
70  allocate(u1, u2(2), SOURCE = molda)
71  allocate(u1, u2(2), SOURCE = n1)
72  allocate(u1, u2(2), SOURCE = new_line("a"))
73  allocate(n1%whatever, SOURCE = n2(1))
74  allocate(p1, p2(2), SOURCE = p3)
75  allocate(p3%y, p4(2)%y, SOURCE = B(5))
76
77  ! OK, not unlimited polymorphic or abstract
78  allocate(n1, n2(2))
79  allocate(p3, p4(2))
80end subroutine
81