1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Check for semantic errors in ALLOCATE statements
4
5! Creating a symbol that allocate should accept
6module share
7  real, pointer :: rp
8end module share
9
10module m
11! Creating symbols that allocate should not accept
12  type :: a_type
13    real, allocatable :: x
14    contains
15      procedure, pass :: foo => mfoo
16      procedure, pass :: bar => mbar
17  end type
18
19contains
20  function mfoo(x)
21    class(a_type) :: x
22    class(a_type), allocatable :: foo
23    foo = x
24  end function
25  subroutine mbar(x)
26    class(a_type) :: x
27  end subroutine
28end module
29
30subroutine C932(ed1, ed5, ed7, edc9, edc10, okad1, okpd1, okacd5)
31! Each allocate-object shall be a data pointer or an allocatable variable.
32  use :: share
33  use :: m, only: a_type
34  type TestType1
35    integer, allocatable :: ok(:)
36    integer :: nok(10)
37  end type
38  type TestType2
39    integer, pointer :: ok
40    integer :: nok
41  end type
42  interface
43    function foo(x)
44      real(4) :: foo, x
45    end function
46    subroutine bar()
47    end subroutine
48  end interface
49  real ed1(:), e2
50  real, save :: e3[*]
51  real , target :: e4, ed5(:)
52  real , parameter :: e6 = 5.
53  procedure(foo), pointer :: proc_ptr1 => NULL()
54  procedure(bar), pointer :: proc_ptr2
55  type(TestType1) ed7
56  type(TestType2) e8
57  type(TestType1) edc9[*]
58  type(TestType2) edc10[*]
59  class(a_type), allocatable :: a_var
60
61  real, allocatable :: oka1(:, :), okad1(:, :), oka2
62  real, pointer :: okp1(:, :), okpd1(:, :), okp2
63  real, pointer, save :: okp3
64  real, allocatable, save :: oka3, okac4[:,:]
65  real, allocatable :: okacd5(:, :)[:]
66
67  !ERROR: Name in ALLOCATE statement must be a variable name
68  allocate(foo)
69  !ERROR: Name in ALLOCATE statement must be a variable name
70  allocate(bar)
71  !ERROR: Name in ALLOCATE statement must be a variable name
72  allocate(C932)
73  !ERROR: Name in ALLOCATE statement must be a variable name
74  allocate(proc_ptr1)
75  !ERROR: Name in ALLOCATE statement must be a variable name
76  allocate(proc_ptr2)
77  !ERROR: Name in ALLOCATE statement must be a variable name
78  allocate(a_var%foo)
79  !ERROR: Name in ALLOCATE statement must be a variable name
80  allocate(a_var%bar)
81
82  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
83  allocate(ed1)
84  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
85  allocate(e2)
86  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
87  allocate(e3)
88  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
89  allocate(e4)
90  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
91  allocate(ed5)
92  !ERROR: Name in ALLOCATE statement must be a variable name
93  allocate(e6)
94  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
95  allocate(ed7)
96  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
97  allocate(ed7%nok(2))
98  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
99  allocate(ed8)
100  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
101  allocate(ed8)
102  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
103  allocate(edc9%nok)
104  !ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
105  allocate(edc10)
106
107  ! No errors expected below:
108  allocate(a_var)
109  allocate(a_var%x)
110  allocate(oka1(5, 7), okad1(4, 8), oka2)
111  allocate(okp1(5, 7), okpd1(4, 8), okp2)
112  allocate(okp1(5, 7), okpd1(4, 8), okp2)
113  allocate(okp3, oka3)
114  allocate(okac4[2:4,4:*])
115  allocate(okacd5(1:2,3:4)[5:*])
116  allocate(ed7%ok(7))
117  allocate(e8%ok)
118  allocate(edc9%ok(4))
119  allocate(edc10%ok)
120  allocate(rp)
121end subroutine
122