1 | //===-- lib/Semantics/assignment.cpp --------------------------------------===// |
---|---|
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #include "assignment.h" |
10 | #include "definable.h" |
11 | #include "pointer-assignment.h" |
12 | #include "flang/Common/idioms.h" |
13 | #include "flang/Common/restorer.h" |
14 | #include "flang/Evaluate/characteristics.h" |
15 | #include "flang/Evaluate/expression.h" |
16 | #include "flang/Evaluate/fold.h" |
17 | #include "flang/Evaluate/tools.h" |
18 | #include "flang/Parser/message.h" |
19 | #include "flang/Parser/parse-tree-visitor.h" |
20 | #include "flang/Parser/parse-tree.h" |
21 | #include "flang/Semantics/expression.h" |
22 | #include "flang/Semantics/symbol.h" |
23 | #include "flang/Semantics/tools.h" |
24 | #include <optional> |
25 | #include <set> |
26 | #include <string> |
27 | #include <type_traits> |
28 | |
29 | using namespace Fortran::parser::literals; |
30 | |
31 | namespace Fortran::semantics { |
32 | |
33 | class AssignmentContext { |
34 | public: |
35 | explicit AssignmentContext(SemanticsContext &context) : context_{context} {} |
36 | AssignmentContext(AssignmentContext &&) = default; |
37 | AssignmentContext(const AssignmentContext &) = delete; |
38 | bool operator==(const AssignmentContext &x) const { return this == &x; } |
39 | |
40 | template <typename A> void PushWhereContext(const A &); |
41 | void PopWhereContext(); |
42 | void Analyze(const parser::AssignmentStmt &); |
43 | void Analyze(const parser::PointerAssignmentStmt &); |
44 | void Analyze(const parser::ConcurrentControl &); |
45 | int deviceConstructDepth_{0}; |
46 | SemanticsContext &context() { return context_; } |
47 | |
48 | private: |
49 | bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource); |
50 | void CheckShape(parser::CharBlock, const SomeExpr *); |
51 | template <typename... A> |
52 | parser::Message *Say(parser::CharBlock at, A &&...args) { |
53 | return &context_.Say(at, std::forward<A>(args)...); |
54 | } |
55 | evaluate::FoldingContext &foldingContext() { |
56 | return context_.foldingContext(); |
57 | } |
58 | |
59 | SemanticsContext &context_; |
60 | int whereDepth_{0}; // number of WHEREs currently nested in |
61 | // shape of masks in LHS of assignments in current WHERE: |
62 | std::vector<std::optional<std::int64_t>> whereExtents_; |
63 | }; |
64 | |
65 | void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) { |
66 | if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) { |
67 | const SomeExpr &lhs{assignment->lhs}; |
68 | const SomeExpr &rhs{assignment->rhs}; |
69 | auto lhsLoc{std::get<parser::Variable>(stmt.t).GetSource()}; |
70 | const Scope &scope{context_.FindScope(lhsLoc)}; |
71 | DefinabilityFlags flags{DefinabilityFlag::VectorSubscriptIsOk}; |
72 | bool isDefinedAssignment{ |
73 | std::holds_alternative<evaluate::ProcedureRef>(assignment->u)}; |
74 | if (isDefinedAssignment) { |
75 | flags.set(DefinabilityFlag::AllowEventLockOrNotifyType); |
76 | } else if (const Symbol * |
77 | whole{evaluate::UnwrapWholeSymbolOrComponentDataRef(lhs)}) { |
78 | if (IsAllocatable(whole->GetUltimate())) { |
79 | flags.set(DefinabilityFlag::PotentialDeallocation); |
80 | } |
81 | } |
82 | if (auto whyNot{WhyNotDefinable(lhsLoc, scope, flags, lhs)}) { |
83 | if (whyNot->IsFatal()) { |
84 | if (auto *msg{Say(lhsLoc, |
85 | "Left-hand side of assignment is not definable"_err_en_US)}) { |
86 | msg->Attach( |
87 | std::move(whyNot->set_severity(parser::Severity::Because))); |
88 | } |
89 | } else { |
90 | context_.Say(std::move(*whyNot)); |
91 | } |
92 | } |
93 | auto rhsLoc{std::get<parser::Expr>(stmt.t).source}; |
94 | if (!isDefinedAssignment) { |
95 | CheckForPureContext(rhs, rhsLoc); |
96 | } |
97 | if (whereDepth_ > 0) { |
98 | CheckShape(lhsLoc, &lhs); |
99 | } |
100 | if (context_.foldingContext().languageFeatures().IsEnabled( |
101 | common::LanguageFeature::CUDA)) { |
102 | const auto &scope{context_.FindScope(lhsLoc)}; |
103 | const Scope &progUnit{GetProgramUnitContaining(scope)}; |
104 | if (!IsCUDADeviceContext(&progUnit) && deviceConstructDepth_ == 0) { |
105 | if (Fortran::evaluate::HasCUDADeviceAttrs(lhs) && |
106 | Fortran::evaluate::HasCUDAImplicitTransfer(rhs)) { |
107 | if (GetNbOfCUDAManagedOrUnifiedSymbols(lhs) == 1 && |
108 | GetNbOfCUDAManagedOrUnifiedSymbols(rhs) == 1 && |
109 | GetNbOfCUDADeviceSymbols(rhs) == 1) |
110 | return; // This is a special case handled on the host. |
111 | context_.Say(lhsLoc, "Unsupported CUDA data transfer"_err_en_US); |
112 | } |
113 | } |
114 | } |
115 | } |
116 | } |
117 | |
118 | void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) { |
119 | CHECK(whereDepth_ == 0); |
120 | if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) { |
121 | parser::CharBlock at{context_.location().value()}; |
122 | auto restorer{foldingContext().messages().SetLocation(at)}; |
123 | CheckPointerAssignment(context_, *assignment, context_.FindScope(at)); |
124 | } |
125 | } |
126 | |
127 | static std::optional<std::string> GetPointerComponentDesignatorName( |
128 | const SomeExpr &expr) { |
129 | if (const auto *derived{ |
130 | evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(expr))}) { |
131 | PotentialAndPointerComponentIterator potentials{*derived}; |
132 | if (auto pointer{ |
133 | std::find_if(potentials.begin(), potentials.end(), IsPointer)}) { |
134 | return pointer.BuildResultDesignatorName(); |
135 | } |
136 | } |
137 | return std::nullopt; |
138 | } |
139 | |
140 | // Checks C1594(5,6); false if check fails |
141 | bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages, |
142 | const SomeExpr &expr, const Scope &scope) { |
143 | if (auto pointer{GetPointerComponentDesignatorName(expr)}) { |
144 | if (const Symbol * base{GetFirstSymbol(expr)}) { |
145 | const char *why{WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)}; |
146 | if (!why) { |
147 | if (auto coarray{evaluate::ExtractCoarrayRef(expr)}) { |
148 | base = &coarray->GetLastSymbol(); |
149 | why = "coindexed"; |
150 | } |
151 | } |
152 | if (why) { |
153 | evaluate::SayWithDeclaration(messages, *base, |
154 | "A pure subprogram may not copy the value of '%s' because it is %s" |
155 | " and has the POINTER potential subobject component '%s'"_err_en_US, |
156 | base->name(), why, *pointer); |
157 | return false; |
158 | } |
159 | } |
160 | } |
161 | return true; |
162 | } |
163 | |
164 | bool AssignmentContext::CheckForPureContext( |
165 | const SomeExpr &rhs, parser::CharBlock rhsSource) { |
166 | const Scope &scope{context_.FindScope(rhsSource)}; |
167 | if (FindPureProcedureContaining(scope)) { |
168 | parser::ContextualMessages messages{ |
169 | context_.location().value(), &context_.messages()}; |
170 | return CheckCopyabilityInPureScope(messages, rhs, scope); |
171 | } else { |
172 | return true; |
173 | } |
174 | } |
175 | |
176 | // 10.2.3.1(2) The masks and LHS of assignments must be arrays of the same shape |
177 | void AssignmentContext::CheckShape(parser::CharBlock at, const SomeExpr *expr) { |
178 | if (auto shape{evaluate::GetShape(foldingContext(), expr)}) { |
179 | std::size_t size{shape->size()}; |
180 | if (size == 0) { |
181 | Say(at, "The mask or variable must not be scalar"_err_en_US); |
182 | } |
183 | if (whereDepth_ == 0) { |
184 | whereExtents_.resize(size); |
185 | } else if (whereExtents_.size() != size) { |
186 | Say(at, |
187 | "Must have rank %zd to match prior mask or assignment of" |
188 | " WHERE construct"_err_en_US, |
189 | whereExtents_.size()); |
190 | return; |
191 | } |
192 | for (std::size_t i{0}; i < size; ++i) { |
193 | if (std::optional<std::int64_t> extent{evaluate::ToInt64((*shape)[i])}) { |
194 | if (!whereExtents_[i]) { |
195 | whereExtents_[i] = *extent; |
196 | } else if (*whereExtents_[i] != *extent) { |
197 | Say(at, |
198 | "Dimension %d must have extent %jd to match prior mask or" |
199 | " assignment of WHERE construct"_err_en_US, |
200 | i + 1, *whereExtents_[i]); |
201 | } |
202 | } |
203 | } |
204 | } |
205 | } |
206 | |
207 | template <typename A> void AssignmentContext::PushWhereContext(const A &x) { |
208 | const auto &expr{std::get<parser::LogicalExpr>(x.t)}; |
209 | CheckShape(expr.thing.value().source, GetExpr(context_, expr)); |
210 | ++whereDepth_; |
211 | } |
212 | |
213 | void AssignmentContext::PopWhereContext() { |
214 | --whereDepth_; |
215 | if (whereDepth_ == 0) { |
216 | whereExtents_.clear(); |
217 | } |
218 | } |
219 | |
220 | AssignmentChecker::~AssignmentChecker() {} |
221 | |
222 | SemanticsContext &AssignmentChecker::context() { |
223 | return context_.value().context(); |
224 | } |
225 | |
226 | AssignmentChecker::AssignmentChecker(SemanticsContext &context) |
227 | : context_{new AssignmentContext{context}} {} |
228 | |
229 | void AssignmentChecker::Enter( |
230 | const parser::OpenMPDeclareReductionConstruct &x) { |
231 | context().set_location(x.source); |
232 | } |
233 | void AssignmentChecker::Enter(const parser::AssignmentStmt &x) { |
234 | context_.value().Analyze(x); |
235 | } |
236 | void AssignmentChecker::Enter(const parser::PointerAssignmentStmt &x) { |
237 | context_.value().Analyze(x); |
238 | } |
239 | void AssignmentChecker::Enter(const parser::WhereStmt &x) { |
240 | context_.value().PushWhereContext(x); |
241 | } |
242 | void AssignmentChecker::Leave(const parser::WhereStmt &) { |
243 | context_.value().PopWhereContext(); |
244 | } |
245 | void AssignmentChecker::Enter(const parser::WhereConstructStmt &x) { |
246 | context_.value().PushWhereContext(x); |
247 | } |
248 | void AssignmentChecker::Leave(const parser::EndWhereStmt &) { |
249 | context_.value().PopWhereContext(); |
250 | } |
251 | void AssignmentChecker::Enter(const parser::MaskedElsewhereStmt &x) { |
252 | context_.value().PushWhereContext(x); |
253 | } |
254 | void AssignmentChecker::Leave(const parser::MaskedElsewhereStmt &) { |
255 | context_.value().PopWhereContext(); |
256 | } |
257 | void AssignmentChecker::Enter(const parser::CUFKernelDoConstruct &x) { |
258 | ++context_.value().deviceConstructDepth_; |
259 | } |
260 | void AssignmentChecker::Leave(const parser::CUFKernelDoConstruct &) { |
261 | --context_.value().deviceConstructDepth_; |
262 | } |
263 | static bool IsOpenACCComputeConstruct(const parser::OpenACCBlockConstruct &x) { |
264 | const auto &beginBlockDirective = |
265 | std::get<Fortran::parser::AccBeginBlockDirective>(x.t); |
266 | const auto &blockDirective = |
267 | std::get<Fortran::parser::AccBlockDirective>(beginBlockDirective.t); |
268 | if (blockDirective.v == llvm::acc::ACCD_parallel || |
269 | blockDirective.v == llvm::acc::ACCD_serial || |
270 | blockDirective.v == llvm::acc::ACCD_kernels) { |
271 | return true; |
272 | } |
273 | return false; |
274 | } |
275 | void AssignmentChecker::Enter(const parser::OpenACCBlockConstruct &x) { |
276 | if (IsOpenACCComputeConstruct(x)) { |
277 | ++context_.value().deviceConstructDepth_; |
278 | } |
279 | } |
280 | void AssignmentChecker::Leave(const parser::OpenACCBlockConstruct &x) { |
281 | if (IsOpenACCComputeConstruct(x)) { |
282 | --context_.value().deviceConstructDepth_; |
283 | } |
284 | } |
285 | void AssignmentChecker::Enter(const parser::OpenACCCombinedConstruct &) { |
286 | ++context_.value().deviceConstructDepth_; |
287 | } |
288 | void AssignmentChecker::Leave(const parser::OpenACCCombinedConstruct &) { |
289 | --context_.value().deviceConstructDepth_; |
290 | } |
291 | void AssignmentChecker::Enter(const parser::OpenACCLoopConstruct &) { |
292 | ++context_.value().deviceConstructDepth_; |
293 | } |
294 | void AssignmentChecker::Leave(const parser::OpenACCLoopConstruct &) { |
295 | --context_.value().deviceConstructDepth_; |
296 | } |
297 | |
298 | } // namespace Fortran::semantics |
299 | template class Fortran::common::Indirection< |
300 | Fortran::semantics::AssignmentContext>; |
301 |
Definitions
- AssignmentContext
- AssignmentContext
- AssignmentContext
- AssignmentContext
- operator==
- context
- Say
- foldingContext
- Analyze
- Analyze
- GetPointerComponentDesignatorName
- CheckCopyabilityInPureScope
- CheckForPureContext
- CheckShape
- PushWhereContext
- PopWhereContext
- ~AssignmentChecker
- context
- AssignmentChecker
- Enter
- Enter
- Enter
- Enter
- Leave
- Enter
- Leave
- Enter
- Leave
- Enter
- Leave
- IsOpenACCComputeConstruct
- Enter
- Leave
- Enter
- Leave
- Enter
Learn to use CMake with our Intro Training
Find out more