xref: /llvm-project/flang/test/Semantics/allocate08.f90 (revision d46c639ebf19eacc6bd37240981ff1b1ef497b1b) 
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Check for semantic errors in ALLOCATE statements
3
4subroutine C945_a(srca, srcb, srcc, src_complex, src_logical, &
5  srca2, srcb2, srcc2, src_complex2, srcx, srcx2)
6! If type-spec appears, it shall specify a type with which each
7! allocate-object is type compatible.
8
9!second part C945, specific to SOURCE, is not checked here.
10
11  type A
12    integer i
13  end type
14
15  type, extends(A) :: B
16    real, allocatable :: x(:)
17  end type
18
19  type, extends(B) :: C
20    character(5) s
21  end type
22
23  type Unrelated
24    class(A), allocatable :: polymorph
25    type(A), allocatable :: notpolymorph
26  end type
27
28  real srcx, srcx2(6)
29  class(A) srca, srca2(5)
30  type(B) srcb, srcb2(6)
31  class(C) srcc, srcc2(7)
32  complex src_complex, src_complex2(8)
33  complex src_logical(5)
34  real, allocatable :: x1, x2(:)
35  class(A), allocatable :: aa1, aa2(:)
36  class(B), pointer :: bp1, bp2(:)
37  class(C), allocatable :: ca1, ca2(:)
38  class(*), pointer :: up1, up2(:)
39  type(A), allocatable :: npaa1, npaa2(:)
40  type(B), pointer :: npbp1, npbp2(:)
41  type(C), allocatable :: npca1, npca2(:)
42  class(Unrelated), allocatable :: unrelat
43
44  allocate(x1, source=srcx)
45  allocate(x2, mold=srcx2)
46  allocate(bp2(3)%x, source=srcx2)
47  !OK, type-compatible with A
48  allocate(aa1, up1, unrelat%polymorph, unrelat%notpolymorph, &
49    npaa1, source=srca)
50  allocate(aa2, up2, npaa2, source=srca2)
51  !OK, type compatible with B
52  allocate(aa1, up1, unrelat%polymorph, bp1, npbp1, mold=srcb)
53  allocate(aa2, up2, bp2, npbp2, mold=srcb2)
54  !OK, type compatible with C
55  allocate(aa1, up1, unrelat%polymorph, bp1, ca1, npca1, mold=srcc)
56  allocate(aa2, up2, bp2, ca2, npca2, source=srcc2)
57
58
59  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
60  allocate(x1, mold=src_complex)
61  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
62  allocate(x2(2), source=src_complex2)
63  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
64  allocate(bp2(3)%x, mold=src_logical)
65  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
66  allocate(unrelat, mold=srca)
67  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
68  allocate(unrelat%notpolymorph, source=srcb)
69  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
70  allocate(npaa1, mold=srcb)
71  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
72  allocate(npaa2, source=srcb2)
73  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
74  allocate(npca1, bp1, npbp1, mold=srcc)
75end subroutine
76
77module m
78  type :: t
79    real x(100)
80   contains
81    procedure :: f
82  end type
83 contains
84  function f(this) result (x)
85    class(t) :: this
86    class(t), allocatable :: x
87  end function
88  subroutine bar
89    type(t) :: o
90    type(t), allocatable :: p
91    real, allocatable :: rp
92    allocate(p, source=o%f())
93    !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
94    allocate(rp, source=o%f())
95  end subroutine
96end module
97
98module mod1
99  type, bind(C) :: t
100     integer :: n
101  end type
102  type(t), allocatable :: x
103end
104
105module mod2
106  type, bind(C) :: t
107     integer :: n
108  end type
109  type(t), allocatable :: x
110end
111
112module mod3
113  type, bind(C) :: t
114     real :: a
115  end type
116  type(t), allocatable :: x
117end
118
119subroutine same_type
120  use mod1, only: a => x
121  use mod2, only: b => x
122  use mod3, only: c => x
123  allocate(a)
124  allocate(b, source=a) ! ok
125  deallocate(a)
126  allocate(a, source=b) ! ok
127  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
128  allocate(c, source=a)
129  deallocate(a)
130  !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
131  allocate(a, source=c)
132end
133
134! Related to C945, check typeless expression are caught
135
136subroutine sub
137end subroutine
138
139function func() result(x)
140  real :: x
141end function
142
143program test_typeless
144  class(*), allocatable :: x
145  interface
146    subroutine sub
147    end subroutine
148    real function func()
149    end function
150  end interface
151  procedure (sub), pointer :: subp => sub
152  procedure (func), pointer :: funcp => func
153
154  ! OK
155  allocate(x, mold=func())
156  allocate(x, source=funcp())
157
158  !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
159  allocate(x, mold=x'1')
160  !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
161  allocate(x, mold=sub)
162  !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
163  allocate(x, source=subp)
164  !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
165  allocate(x, mold=func)
166  !ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
167  allocate(x, source=funcp)
168end program
169