1	//===-- lib/Semantics/check-omp-structure.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 "check-omp-structure.h"
10	#include "definable.h"
11	#include "flang/Parser/parse-tree.h"
12	#include "flang/Semantics/tools.h"
13
14	namespace Fortran::semantics {
15
16	// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
17	#define CHECK_SIMPLE_CLAUSE(X, Y) \
18	void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
19	CheckAllowed(llvm::omp::Clause::Y); \
20	}
21
22	#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
23	void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
24	CheckAllowed(llvm::omp::Clause::Y); \
25	RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
26	}
27
28	#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
29	void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
30	CheckAllowed(llvm::omp::Clause::Y); \
31	RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
32	}
33
34	// Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
35	#define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
36	void OmpStructureChecker::Enter(const parser::X &) { \
37	CheckAllowed(llvm::omp::Y); \
38	}
39
40	// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
41	// statements and the expressions enclosed in an OpenMP Workshare construct
42	class OmpWorkshareBlockChecker {
43	public:
44	OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
45	: context_{context}, source_{source} {}
46
47	template <typename T> bool Pre(const T &) { return true; }
48	template <typename T> void Post(const T &) {}
49
50	bool Pre(const parser::AssignmentStmt &assignment) {
51	const auto &var{std::get<parser::Variable>(assignment.t)};
52	const auto &expr{std::get<parser::Expr>(assignment.t)};
53	const auto *lhs{GetExpr(context_, var)};
54	const auto *rhs{GetExpr(context_, expr)};
55	if (lhs && rhs) {
56	Tristate isDefined{semantics::IsDefinedAssignment(
57	lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
58	if (isDefined == Tristate::Yes) {
59	context_.Say(expr.source,
60	"Defined assignment statement is not "
61	"allowed in a WORKSHARE construct"_err_en_US);
62	}
63	}
64	return true;
65	}
66
67	bool Pre(const parser::Expr &expr) {
68	if (const auto *e{GetExpr(context_, expr)}) {
69	for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
70	const Symbol &root{GetAssociationRoot(symbol)};
71	if (IsFunction(root) && !IsElementalProcedure(root)) {
72	context_.Say(expr.source,
73	"User defined non-ELEMENTAL function "
74	"'%s' is not allowed in a WORKSHARE construct"_err_en_US,
75	root.name());
76	}
77	}
78	}
79	return false;
80	}
81
82	private:
83	SemanticsContext &context_;
84	parser::CharBlock source_;
85	};
86
87	class OmpCycleChecker {
88	public:
89	OmpCycleChecker(SemanticsContext &context, std::int64_t cycleLevel)
90	: context_{context}, cycleLevel_{cycleLevel} {}
91
92	template <typename T> bool Pre(const T &) { return true; }
93	template <typename T> void Post(const T &) {}
94
95	bool Pre(const parser::DoConstruct &dc) {
96	cycleLevel_--;
97	const auto &labelName{std::get<0>(std::get<0>(dc.t).statement.t)};
98	if (labelName) {
99	labelNamesandLevels_.emplace(labelName.value().ToString(), cycleLevel_);
100	}
101	return true;
102	}
103
104	bool Pre(const parser::CycleStmt &cyclestmt) {
105	std::map<std::string, std::int64_t>::iterator it;
106	bool err{false};
107	if (cyclestmt.v) {
108	it = labelNamesandLevels_.find(cyclestmt.v->source.ToString());
109	err = (it != labelNamesandLevels_.end() && it->second > 0);
110	}
111	if (cycleLevel_ > 0 || err) {
112	context_.Say(*cycleSource_,
113	"CYCLE statement to non-innermost associated loop of an OpenMP DO "
114	"construct"_err_en_US);
115	}
116	return true;
117	}
118
119	bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
120	cycleSource_ = &actionstmt.source;
121	return true;
122	}
123
124	private:
125	SemanticsContext &context_;
126	const parser::CharBlock *cycleSource_;
127	std::int64_t cycleLevel_;
128	std::map<std::string, std::int64_t> labelNamesandLevels_;
129	};
130
131	bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
132	// Definition of close nesting:
133	//
134	// `A region nested inside another region with no parallel region nested
135	// between them`
136	//
137	// Examples:
138	// non-parallel construct 1
139	// non-parallel construct 2
140	// parallel construct
141	// construct 3
142	// In the above example, construct 3 is NOT closely nested inside construct 1
143	// or 2
144	//
145	// non-parallel construct 1
146	// non-parallel construct 2
147	// construct 3
148	// In the above example, construct 3 is closely nested inside BOTH construct 1
149	// and 2
150	//
151	// Algorithm:
152	// Starting from the parent context, Check in a bottom-up fashion, each level
153	// of the context stack. If we have a match for one of the (supplied)
154	// violating directives, `close nesting` is satisfied. If no match is there in
155	// the entire stack, `close nesting` is not satisfied. If at any level, a
156	// `parallel` region is found, `close nesting` is not satisfied.
157
158	if (CurrentDirectiveIsNested()) {
159	int index = dirContext_.size() - 2;
160	while (index != -1) {
161	if (set.test(dirContext_[index].directive)) {
162	return true;
163	} else if (llvm::omp::allParallelSet.test(dirContext_[index].directive)) {
164	return false;
165	}
166	index--;
167	}
168	}
169	return false;
170	}
171
172	void OmpStructureChecker::CheckMultipleOccurrence(
173	semantics::UnorderedSymbolSet &listVars,
174	const std::list<parser::Name> &nameList, const parser::CharBlock &item,
175	const std::string &clauseName) {
176	for (auto const &var : nameList) {
177	if (llvm::is_contained(listVars, *(var.symbol))) {
178	context_.Say(item,
179	"List item '%s' present at multiple %s clauses"_err_en_US,
180	var.ToString(), clauseName);
181	}
182	listVars.insert(*(var.symbol));
183	}
184	}
185
186	void OmpStructureChecker::CheckMultListItems() {
187	semantics::UnorderedSymbolSet listVars;
188
189	// Aligned clause
190	auto alignedClauses{FindClauses(llvm::omp::Clause::OMPC_aligned)};
191	for (auto itr = alignedClauses.first; itr != alignedClauses.second; ++itr) {
192	const auto &alignedClause{
193	std::get<parser::OmpClause::Aligned>(itr->second->u)};
194	const auto &alignedList{std::get<0>(alignedClause.v.t)};
195	std::list<parser::Name> alignedNameList;
196	for (const auto &ompObject : alignedList.v) {
197	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
198	if (name->symbol) {
199	if (FindCommonBlockContaining(*(name->symbol))) {
200	context_.Say(itr->second->source,
201	"'%s' is a common block name and can not appear in an "
202	"ALIGNED clause"_err_en_US,
203	name->ToString());
204	} else if (!(IsBuiltinCPtr(*(name->symbol)) ||
205	IsAllocatableOrObjectPointer(
206	&name->symbol->GetUltimate()))) {
207	context_.Say(itr->second->source,
208	"'%s' in ALIGNED clause must be of type C_PTR, POINTER or "
209	"ALLOCATABLE"_err_en_US,
210	name->ToString());
211	} else {
212	alignedNameList.push_back(*name);
213	}
214	} else {
215	// The symbol is null, return early
216	return;
217	}
218	}
219	}
220	CheckMultipleOccurrence(
221	listVars, alignedNameList, itr->second->source, "ALIGNED");
222	}
223
224	// Nontemporal clause
225	auto nonTemporalClauses{FindClauses(llvm::omp::Clause::OMPC_nontemporal)};
226	for (auto itr = nonTemporalClauses.first; itr != nonTemporalClauses.second;
227	++itr) {
228	const auto &nontempClause{
229	std::get<parser::OmpClause::Nontemporal>(itr->second->u)};
230	const auto &nontempNameList{nontempClause.v};
231	CheckMultipleOccurrence(
232	listVars, nontempNameList, itr->second->source, "NONTEMPORAL");
233	}
234	}
235
236	bool OmpStructureChecker::HasInvalidWorksharingNesting(
237	const parser::CharBlock &source, const OmpDirectiveSet &set) {
238	// set contains all the invalid closely nested directives
239	// for the given directive (`source` here)
240	if (IsCloselyNestedRegion(set)) {
241	context_.Say(source,
242	"A worksharing region may not be closely nested inside a "
243	"worksharing, explicit task, taskloop, critical, ordered, atomic, or "
244	"master region"_err_en_US);
245	return true;
246	}
247	return false;
248	}
249
250	void OmpStructureChecker::HasInvalidDistributeNesting(
251	const parser::OpenMPLoopConstruct &x) {
252	bool violation{false};
253	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
254	const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
255	if (llvm::omp::topDistributeSet.test(beginDir.v)) {
256	// `distribute` region has to be nested
257	if (!CurrentDirectiveIsNested()) {
258	violation = true;
259	} else {
260	// `distribute` region has to be strictly nested inside `teams`
261	if (!llvm::omp::topTeamsSet.test(GetContextParent().directive)) {
262	violation = true;
263	}
264	}
265	}
266	if (violation) {
267	context_.Say(beginDir.source,
268	"`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
269	"region."_err_en_US);
270	}
271	}
272
273	void OmpStructureChecker::HasInvalidTeamsNesting(
274	const llvm::omp::Directive &dir, const parser::CharBlock &source) {
275	if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
276	context_.Say(source,
277	"Only `DISTRIBUTE` or `PARALLEL` regions are allowed to be strictly "
278	"nested inside `TEAMS` region."_err_en_US);
279	}
280	}
281
282	void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
283	const parser::CharBlock &source, const parser::Name &name) {
284	if (const auto *symbol{name.symbol}) {
285	const auto *commonBlock{FindCommonBlockContaining(*symbol)};
286	const auto &scope{context_.FindScope(symbol->name())};
287	const Scope &containingScope{GetProgramUnitContaining(scope)};
288	if (!isPredefinedAllocator &&
289	(IsSaved(*symbol) || commonBlock ||
290	containingScope.kind() == Scope::Kind::Module)) {
291	context_.Say(source,
292	"If list items within the %s directive have the "
293	"SAVE attribute, are a common block name, or are "
294	"declared in the scope of a module, then only "
295	"predefined memory allocator parameters can be used "
296	"in the allocator clause"_err_en_US,
297	ContextDirectiveAsFortran());
298	}
299	}
300	}
301
302	void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
303	const parser::CharBlock &source,
304	const parser::OmpObjectList &ompObjectList) {
305	for (const auto &ompObject : ompObjectList.v) {
306	common::visit(
307	common::visitors{
308	[&](const parser::Designator &designator) {
309	if (const auto *dataRef{
310	std::get_if<parser::DataRef>(&designator.u)}) {
311	if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
312	CheckPredefinedAllocatorRestriction(source, *name);
313	}
314	}
315	},
316	[&](const parser::Name &name) {
317	CheckPredefinedAllocatorRestriction(source, name);
318	},
319	},
320	ompObject.u);
321	}
322	}
323
324	template <class D>
325	void OmpStructureChecker::CheckHintClause(
326	D *leftOmpClauseList, D *rightOmpClauseList) {
327	auto checkForValidHintClause = [&](const D *clauseList) {
328	for (const auto &clause : clauseList->v) {
329	const Fortran::parser::OmpClause *ompClause = nullptr;
330	if constexpr (std::is_same_v<D,
331	const Fortran::parser::OmpAtomicClauseList>) {
332	ompClause = std::get_if<Fortran::parser::OmpClause>(&clause.u);
333	if (!ompClause)
334	continue;
335	} else if constexpr (std::is_same_v<D,
336	const Fortran::parser::OmpClauseList>) {
337	ompClause = &clause;
338	}
339	if (const Fortran::parser::OmpClause::Hint *
340	hintClause{
341	std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u)}) {
342	std::optional<std::int64_t> hintValue = GetIntValue(hintClause->v);
343	if (hintValue && *hintValue >= 0) {
344	/*`omp_sync_hint_nonspeculative` and `omp_lock_hint_speculative`*/
345	if ((*hintValue & 0xC) == 0xC
346	/*`omp_sync_hint_uncontended` and omp_sync_hint_contended*/
347	|| (*hintValue & 0x3) == 0x3)
348	context_.Say(clause.source,
349	"Hint clause value "
350	"is not a valid OpenMP synchronization value"_err_en_US);
351	} else {
352	context_.Say(clause.source,
353	"Hint clause must have non-negative constant "
354	"integer expression"_err_en_US);
355	}
356	}
357	}
358	};
359
360	if (leftOmpClauseList) {
361	checkForValidHintClause(leftOmpClauseList);
362	}
363	if (rightOmpClauseList) {
364	checkForValidHintClause(rightOmpClauseList);
365	}
366	}
367
368	void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
369	// Simd Construct with Ordered Construct Nesting check
370	// We cannot use CurrentDirectiveIsNested() here because
371	// PushContextAndClauseSets() has not been called yet, it is
372	// called individually for each construct. Therefore a
373	// dirContext_ size `1` means the current construct is nested
374	if (dirContext_.size() >= 1) {
375	if (GetDirectiveNest(index: SIMDNest) > 0) {
376	CheckSIMDNest(x);
377	}
378	if (GetDirectiveNest(index: TargetNest) > 0) {
379	CheckTargetNest(x);
380	}
381	}
382	}
383
384	void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
385	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
386	const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
387
388	// check matching, End directive is optional
389	if (const auto &endLoopDir{
390	std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
391	const auto &endDir{
392	std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
393
394	CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
395	}
396
397	PushContextAndClauseSets(beginDir.source, beginDir.v);
398	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
399	EnterDirectiveNest(index: SIMDNest);
400	}
401
402	// Combined target loop constructs are target device constructs. Keep track of
403	// whether any such construct has been visited to later check that REQUIRES
404	// directives for target-related options don't appear after them.
405	if (llvm::omp::allTargetSet.test(beginDir.v)) {
406	deviceConstructFound_ = true;
407	}
408
409	if (beginDir.v == llvm::omp::Directive::OMPD_do) {
410	// 2.7.1 do-clause -> private-clause |
411	// firstprivate-clause |
412	// lastprivate-clause |
413	// linear-clause |
414	// reduction-clause |
415	// schedule-clause |
416	// collapse-clause |
417	// ordered-clause
418
419	// nesting check
420	HasInvalidWorksharingNesting(
421	beginDir.source, llvm::omp::nestedWorkshareErrSet);
422	}
423	SetLoopInfo(x);
424
425	if (const auto &doConstruct{
426	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
427	const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
428	CheckNoBranching(doBlock, beginDir.v, beginDir.source);
429	}
430	CheckDoWhile(x);
431	CheckLoopItrVariableIsInt(x);
432	CheckCycleConstraints(x);
433	HasInvalidDistributeNesting(x);
434	if (CurrentDirectiveIsNested() &&
435	llvm::omp::topTeamsSet.test(GetContextParent().directive)) {
436	HasInvalidTeamsNesting(beginDir.v, beginDir.source);
437	}
438	if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
439	(beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
440	CheckDistLinear(x);
441	}
442	}
443	const parser::Name OmpStructureChecker::GetLoopIndex(
444	const parser::DoConstruct *x) {
445	using Bounds = parser::LoopControl::Bounds;
446	return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
447	}
448	void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
449	if (const auto &loopConstruct{
450	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
451	const parser::DoConstruct *loop{&*loopConstruct};
452	if (loop && loop->IsDoNormal()) {
453	const parser::Name &itrVal{GetLoopIndex(loop)};
454	SetLoopIv(itrVal.symbol);
455	}
456	}
457	}
458	void OmpStructureChecker::CheckDoWhile(const parser::OpenMPLoopConstruct &x) {
459	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
460	const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
461	if (beginDir.v == llvm::omp::Directive::OMPD_do) {
462	if (const auto &doConstruct{
463	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
464	if (doConstruct.value().IsDoWhile()) {
465	const auto &doStmt{std::get<parser::Statement<parser::NonLabelDoStmt>>(
466	doConstruct.value().t)};
467	context_.Say(doStmt.source,
468	"The DO loop cannot be a DO WHILE with DO directive."_err_en_US);
469	}
470	}
471	}
472	}
473
474	void OmpStructureChecker::CheckLoopItrVariableIsInt(
475	const parser::OpenMPLoopConstruct &x) {
476	if (const auto &loopConstruct{
477	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
478
479	for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
480	if (loop->IsDoNormal()) {
481	const parser::Name &itrVal{GetLoopIndex(loop)};
482	if (itrVal.symbol) {
483	const auto *type{itrVal.symbol->GetType()};
484	if (!type->IsNumeric(TypeCategory::Integer)) {
485	context_.Say(itrVal.source,
486	"The DO loop iteration"
487	" variable must be of the type integer."_err_en_US,
488	itrVal.ToString());
489	}
490	}
491	}
492	// Get the next DoConstruct if block is not empty.
493	const auto &block{std::get<parser::Block>(loop->t)};
494	const auto it{block.begin()};
495	loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
496	: nullptr;
497	}
498	}
499	}
500
501	void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
502	// Check the following:
503	// The only OpenMP constructs that can be encountered during execution of
504	// a simd region are the `atomic` construct, the `loop` construct, the `simd`
505	// construct and the `ordered` construct with the `simd` clause.
506	// TODO: Expand the check to include `LOOP` construct as well when it is
507	// supported.
508
509	// Check if the parent context has the SIMD clause
510	// Please note that we use GetContext() instead of GetContextParent()
511	// because PushContextAndClauseSets() has not been called on the
512	// current context yet.
513	// TODO: Check for declare simd regions.
514	bool eligibleSIMD{false};
515	common::visit(Fortran::common::visitors{
516	// Allow `!$OMP ORDERED SIMD`
517	[&](const parser::OpenMPBlockConstruct &c) {
518	const auto &beginBlockDir{
519	std::get<parser::OmpBeginBlockDirective>(c.t)};
520	const auto &beginDir{
521	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
522	if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
523	const auto &clauses{
524	std::get<parser::OmpClauseList>(beginBlockDir.t)};
525	for (const auto &clause : clauses.v) {
526	if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
527	eligibleSIMD = true;
528	break;
529	}
530	}
531	}
532	},
533	[&](const parser::OpenMPSimpleStandaloneConstruct &c) {
534	const auto &dir{
535	std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
536	if (dir.v == llvm::omp::Directive::OMPD_ordered) {
537	const auto &clauses{
538	std::get<parser::OmpClauseList>(c.t)};
539	for (const auto &clause : clauses.v) {
540	if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
541	eligibleSIMD = true;
542	break;
543	}
544	}
545	}
546	},
547	// Allowing SIMD construct
548	[&](const parser::OpenMPLoopConstruct &c) {
549	const auto &beginLoopDir{
550	std::get<parser::OmpBeginLoopDirective>(c.t)};
551	const auto &beginDir{
552	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
553	if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
554	(beginDir.v == llvm::omp::Directive::OMPD_do_simd)) {
555	eligibleSIMD = true;
556	}
557	},
558	[&](const parser::OpenMPAtomicConstruct &c) {
559	// Allow `!$OMP ATOMIC`
560	eligibleSIMD = true;
561	},
562	[&](const auto &c) {},
563	},
564	c.u);
565	if (!eligibleSIMD) {
566	context_.Say(parser::FindSourceLocation(c),
567	"The only OpenMP constructs that can be encountered during execution "
568	"of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
569	"the `SIMD` construct and the `ORDERED` construct with the `SIMD` "
570	"clause."_err_en_US);
571	}
572	}
573
574	void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
575	// 2.12.5 Target Construct Restriction
576	bool eligibleTarget{true};
577	llvm::omp::Directive ineligibleTargetDir;
578	common::visit(
579	common::visitors{
580	[&](const parser::OpenMPBlockConstruct &c) {
581	const auto &beginBlockDir{
582	std::get<parser::OmpBeginBlockDirective>(c.t)};
583	const auto &beginDir{
584	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
585	if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
586	eligibleTarget = false;
587	ineligibleTargetDir = beginDir.v;
588	}
589	},
590	[&](const parser::OpenMPStandaloneConstruct &c) {
591	common::visit(
592	common::visitors{
593	[&](const parser::OpenMPSimpleStandaloneConstruct &c) {
594	const auto &dir{
595	std::get<parser::OmpSimpleStandaloneDirective>(c.t)};
596	if (dir.v == llvm::omp::Directive::OMPD_target_update ||
597	dir.v ==
598	llvm::omp::Directive::OMPD_target_enter_data ||
599	dir.v ==
600	llvm::omp::Directive::OMPD_target_exit_data) {
601	eligibleTarget = false;
602	ineligibleTargetDir = dir.v;
603	}
604	},
605	[&](const auto &c) {},
606	},
607	c.u);
608	},
609	[&](const auto &c) {},
610	},
611	c.u);
612	if (!eligibleTarget &&
613	context_.ShouldWarn(common::UsageWarning::Portability)) {
614	context_.Say(parser::FindSourceLocation(c),
615	"If %s directive is nested inside TARGET region, the behaviour "
616	"is unspecified"_port_en_US,
617	parser::ToUpperCaseLetters(
618	getDirectiveName(ineligibleTargetDir).str()));
619	}
620	}
621
622	std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
623	const parser::OpenMPLoopConstruct &x) {
624	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
625	const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
626	std::int64_t orderedCollapseLevel{1};
627	std::int64_t orderedLevel{0};
628	std::int64_t collapseLevel{0};
629
630	for (const auto &clause : clauseList.v) {
631	if (const auto *collapseClause{
632	std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
633	if (const auto v{GetIntValue(collapseClause->v)}) {
634	collapseLevel = *v;
635	}
636	}
637	if (const auto *orderedClause{
638	std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
639	if (const auto v{GetIntValue(orderedClause->v)}) {
640	orderedLevel = *v;
641	}
642	}
643	}
644	if (orderedLevel >= collapseLevel) {
645	orderedCollapseLevel = orderedLevel;
646	} else {
647	orderedCollapseLevel = collapseLevel;
648	}
649	return orderedCollapseLevel;
650	}
651
652	void OmpStructureChecker::CheckCycleConstraints(
653	const parser::OpenMPLoopConstruct &x) {
654	std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
655	OmpCycleChecker ompCycleChecker{context_, ordCollapseLevel};
656	parser::Walk(x, ompCycleChecker);
657	}
658
659	void OmpStructureChecker::CheckDistLinear(
660	const parser::OpenMPLoopConstruct &x) {
661
662	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
663	const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
664
665	semantics::UnorderedSymbolSet indexVars;
666
667	// Collect symbols of all the variables from linear clauses
668	for (const auto &clause : clauses.v) {
669	if (const auto *linearClause{
670	std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
671
672	std::list<parser::Name> values;
673	// Get the variant type
674	if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(
675	linearClause->v.u)) {
676	const auto &withM{
677	std::get<parser::OmpLinearClause::WithModifier>(linearClause->v.u)};
678	values = withM.names;
679	} else {
680	const auto &withOutM{std::get<parser::OmpLinearClause::WithoutModifier>(
681	linearClause->v.u)};
682	values = withOutM.names;
683	}
684	for (auto const &v : values) {
685	indexVars.insert(*(v.symbol));
686	}
687	}
688	}
689
690	if (!indexVars.empty()) {
691	// Get collapse level, if given, to find which loops are "associated."
692	std::int64_t collapseVal{GetOrdCollapseLevel(x)};
693	// Include the top loop if no collapse is specified
694	if (collapseVal == 0) {
695	collapseVal = 1;
696	}
697
698	// Match the loop index variables with the collected symbols from linear
699	// clauses.
700	if (const auto &loopConstruct{
701	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
702	for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
703	if (loop->IsDoNormal()) {
704	const parser::Name &itrVal{GetLoopIndex(loop)};
705	if (itrVal.symbol) {
706	// Remove the symbol from the collcted set
707	indexVars.erase(*(itrVal.symbol));
708	}
709	collapseVal--;
710	if (collapseVal == 0) {
711	break;
712	}
713	}
714	// Get the next DoConstruct if block is not empty.
715	const auto &block{std::get<parser::Block>(loop->t)};
716	const auto it{block.begin()};
717	loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
718	: nullptr;
719	}
720	}
721
722	// Show error for the remaining variables
723	for (auto var : indexVars) {
724	const Symbol &root{GetAssociationRoot(var)};
725	context_.Say(parser::FindSourceLocation(x),
726	"Variable '%s' not allowed in `LINEAR` clause, only loop iterator "
727	"can be specified in `LINEAR` clause of a construct combined with "
728	"`DISTRIBUTE`"_err_en_US,
729	root.name());
730	}
731	}
732	}
733
734	void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
735	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
736	ExitDirectiveNest(index: SIMDNest);
737	}
738	dirContext_.pop_back();
739	}
740
741	void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
742	const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
743	ResetPartialContext(dir.source);
744	switch (dir.v) {
745	// 2.7.1 end-do -> END DO [nowait-clause]
746	// 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
747	case llvm::omp::Directive::OMPD_do:
748	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
749	break;
750	case llvm::omp::Directive::OMPD_do_simd:
751	PushContextAndClauseSets(
752	dir.source, llvm::omp::Directive::OMPD_end_do_simd);
753	break;
754	default:
755	// no clauses are allowed
756	break;
757	}
758	}
759
760	void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
761	if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
762	(GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
763	dirContext_.pop_back();
764	}
765	}
766
767	void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
768	const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
769	const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
770	const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
771	const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
772	const parser::Block &block{std::get<parser::Block>(x.t)};
773
774	CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
775
776	PushContextAndClauseSets(beginDir.source, beginDir.v);
777	if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
778	EnterDirectiveNest(index: TargetNest);
779	}
780
781	if (CurrentDirectiveIsNested()) {
782	if (llvm::omp::topTeamsSet.test(GetContextParent().directive)) {
783	HasInvalidTeamsNesting(beginDir.v, beginDir.source);
784	}
785	if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
786	CheckMasterNesting(x);
787	}
788	// A teams region can only be strictly nested within the implicit parallel
789	// region or a target region.
790	if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
791	GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
792	context_.Say(parser::FindSourceLocation(x),
793	"%s region can only be strictly nested within the implicit parallel "
794	"region or TARGET region"_err_en_US,
795	ContextDirectiveAsFortran());
796	}
797	// If a teams construct is nested within a target construct, that target
798	// construct must contain no statements, declarations or directives outside
799	// of the teams construct.
800	if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
801	GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
802	!GetDirectiveNest(TargetBlockOnlyTeams)) {
803	context_.Say(GetContextParent().directiveSource,
804	"TARGET construct with nested TEAMS region contains statements or "
805	"directives outside of the TEAMS construct"_err_en_US);
806	}
807	}
808
809	CheckNoBranching(block, beginDir.v, beginDir.source);
810
811	// Target block constructs are target device constructs. Keep track of
812	// whether any such construct has been visited to later check that REQUIRES
813	// directives for target-related options don't appear after them.
814	if (llvm::omp::allTargetSet.test(beginDir.v)) {
815	deviceConstructFound_ = true;
816	}
817
818	switch (beginDir.v) {
819	case llvm::omp::Directive::OMPD_target:
820	if (CheckTargetBlockOnlyTeams(block)) {
821	EnterDirectiveNest(index: TargetBlockOnlyTeams);
822	}
823	break;
824	case llvm::omp::OMPD_workshare:
825	case llvm::omp::OMPD_parallel_workshare:
826	CheckWorkshareBlockStmts(block, beginDir.source);
827	HasInvalidWorksharingNesting(
828	beginDir.source, llvm::omp::nestedWorkshareErrSet);
829	break;
830	case llvm::omp::Directive::OMPD_single:
831	// TODO: This check needs to be extended while implementing nesting of
832	// regions checks.
833	HasInvalidWorksharingNesting(
834	beginDir.source, llvm::omp::nestedWorkshareErrSet);
835	break;
836	default:
837	break;
838	}
839	}
840
841	void OmpStructureChecker::CheckMasterNesting(
842	const parser::OpenMPBlockConstruct &x) {
843	// A MASTER region may not be `closely nested` inside a worksharing, loop,
844	// task, taskloop, or atomic region.
845	// TODO: Expand the check to include `LOOP` construct as well when it is
846	// supported.
847	if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
848	context_.Say(parser::FindSourceLocation(x),
849	"`MASTER` region may not be closely nested inside of `WORKSHARING`, "
850	"`LOOP`, `TASK`, `TASKLOOP`,"
851	" or `ATOMIC` region."_err_en_US);
852	}
853	}
854
855	void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
856	if (GetDirectiveNest(index: TargetBlockOnlyTeams)) {
857	ExitDirectiveNest(index: TargetBlockOnlyTeams);
858	}
859	if (GetContext().directive == llvm::omp::Directive::OMPD_target) {
860	ExitDirectiveNest(index: TargetNest);
861	}
862	dirContext_.pop_back();
863	}
864
865	void OmpStructureChecker::ChecksOnOrderedAsBlock() {
866	if (FindClause(llvm::omp::Clause::OMPC_depend)) {
867	context_.Say(GetContext().clauseSource,
868	"DEPEND(*) clauses are not allowed when ORDERED construct is a block"
869	" construct with an ORDERED region"_err_en_US);
870	return;
871	}
872
873	bool isNestedInDo{false};
874	bool isNestedInDoSIMD{false};
875	bool isNestedInSIMD{false};
876	bool noOrderedClause{false};
877	bool isOrderedClauseWithPara{false};
878	bool isCloselyNestedRegion{true};
879	if (CurrentDirectiveIsNested()) {
880	for (int i = (int)dirContext_.size() - 2; i >= 0; i--) {
881	if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) {
882	context_.Say(GetContext().directiveSource,
883	"`ORDERED` region may not be closely nested inside of `CRITICAL`, "
884	"`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
885	break;
886	} else if (llvm::omp::allDoSet.test(dirContext_[i].directive)) {
887	isNestedInDo = true;
888	isNestedInDoSIMD =
889	llvm::omp::allDoSimdSet.test(dirContext_[i].directive);
890	if (const auto *clause{
891	FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) {
892	const auto &orderedClause{
893	std::get<parser::OmpClause::Ordered>(clause->u)};
894	const auto orderedValue{GetIntValue(orderedClause.v)};
895	isOrderedClauseWithPara = orderedValue > 0;
896	} else {
897	noOrderedClause = true;
898	}
899	break;
900	} else if (llvm::omp::allSimdSet.test(dirContext_[i].directive)) {
901	isNestedInSIMD = true;
902	break;
903	} else if (llvm::omp::nestedOrderedParallelErrSet.test(
904	dirContext_[i].directive)) {
905	isCloselyNestedRegion = false;
906	break;
907	}
908	}
909	}
910
911	if (!isCloselyNestedRegion) {
912	context_.Say(GetContext().directiveSource,
913	"An ORDERED directive without the DEPEND clause must be closely nested "
914	"in a SIMD, worksharing-loop, or worksharing-loop SIMD "
915	"region"_err_en_US);
916	} else {
917	if (CurrentDirectiveIsNested() &&
918	FindClause(llvm::omp::Clause::OMPC_simd) &&
919	(!isNestedInDoSIMD && !isNestedInSIMD)) {
920	context_.Say(GetContext().directiveSource,
921	"An ORDERED directive with SIMD clause must be closely nested in a "
922	"SIMD or worksharing-loop SIMD region"_err_en_US);
923	}
924	if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) {
925	context_.Say(GetContext().directiveSource,
926	"An ORDERED directive without the DEPEND clause must be closely "
927	"nested in a worksharing-loop (or worksharing-loop SIMD) region with "
928	"ORDERED clause without the parameter"_err_en_US);
929	}
930	}
931	}
932
933	void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
934	switch (GetContext().directive) {
935	case llvm::omp::Directive::OMPD_ordered:
936	// [5.1] 2.19.9 Ordered Construct Restriction
937	ChecksOnOrderedAsBlock();
938	break;
939	default:
940	break;
941	}
942	}
943
944	void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
945	const auto &beginSectionsDir{
946	std::get<parser::OmpBeginSectionsDirective>(x.t)};
947	const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
948	const auto &beginDir{
949	std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
950	const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
951	CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
952
953	PushContextAndClauseSets(beginDir.source, beginDir.v);
954	const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
955	for (const parser::OpenMPConstruct &block : sectionBlocks.v) {
956	CheckNoBranching(std::get<parser::OpenMPSectionConstruct>(block.u).v,
957	beginDir.v, beginDir.source);
958	}
959	HasInvalidWorksharingNesting(
960	beginDir.source, llvm::omp::nestedWorkshareErrSet);
961	}
962
963	void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
964	dirContext_.pop_back();
965	}
966
967	void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
968	const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
969	ResetPartialContext(dir.source);
970	switch (dir.v) {
971	// 2.7.2 end-sections -> END SECTIONS [nowait-clause]
972	case llvm::omp::Directive::OMPD_sections:
973	PushContextAndClauseSets(
974	dir.source, llvm::omp::Directive::OMPD_end_sections);
975	break;
976	default:
977	// no clauses are allowed
978	break;
979	}
980	}
981
982	// TODO: Verify the popping of dirContext requirement after nowait
983	// implementation, as there is an implicit barrier at the end of the worksharing
984	// constructs unless a nowait clause is specified. Only OMPD_end_sections is
985	// popped becuase it is pushed while entering the EndSectionsDirective.
986	void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
987	if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
988	dirContext_.pop_back();
989	}
990	}
991
992	void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
993	const parser::OmpObjectList &objList) {
994	for (const auto &ompObject : objList.v) {
995	common::visit(
996	common::visitors{
997	[&](const parser::Designator &) {
998	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
999	// The symbol is null, return early, CheckSymbolNames
1000	// should have already reported the missing symbol as a
1001	// diagnostic error
1002	if (!name->symbol) {
1003	return;
1004	}
1005
1006	if (name->symbol->GetUltimate().IsSubprogram()) {
1007	if (GetContext().directive ==
1008	llvm::omp::Directive::OMPD_threadprivate)
1009	context_.Say(name->source,
1010	"The procedure name cannot be in a %s "
1011	"directive"_err_en_US,
1012	ContextDirectiveAsFortran());
1013	// TODO: Check for procedure name in declare target directive.
1014	} else if (name->symbol->attrs().test(Attr::PARAMETER)) {
1015	if (GetContext().directive ==
1016	llvm::omp::Directive::OMPD_threadprivate)
1017	context_.Say(name->source,
1018	"The entity with PARAMETER attribute cannot be in a %s "
1019	"directive"_err_en_US,
1020	ContextDirectiveAsFortran());
1021	else if (GetContext().directive ==
1022	llvm::omp::Directive::OMPD_declare_target)
1023	context_.Say(name->source,
1024	"The entity with PARAMETER attribute is used in a %s "
1025	"directive"_warn_en_US,
1026	ContextDirectiveAsFortran());
1027	} else if (FindCommonBlockContaining(*name->symbol)) {
1028	context_.Say(name->source,
1029	"A variable in a %s directive cannot be an element of a "
1030	"common block"_err_en_US,
1031	ContextDirectiveAsFortran());
1032	} else if (FindEquivalenceSet(*name->symbol)) {
1033	context_.Say(name->source,
1034	"A variable in a %s directive cannot appear in an "
1035	"EQUIVALENCE statement"_err_en_US,
1036	ContextDirectiveAsFortran());
1037	} else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) &&
1038	GetContext().directive ==
1039	llvm::omp::Directive::OMPD_declare_target) {
1040	context_.Say(name->source,
1041	"A THREADPRIVATE variable cannot appear in a %s "
1042	"directive"_err_en_US,
1043	ContextDirectiveAsFortran());
1044	} else {
1045	const semantics::Scope &useScope{
1046	context_.FindScope(GetContext().directiveSource)};
1047	const semantics::Scope &curScope =
1048	name->symbol->GetUltimate().owner();
1049	if (!curScope.IsTopLevel()) {
1050	const semantics::Scope &declScope =
1051	GetProgramUnitOrBlockConstructContaining(curScope);
1052	const semantics::Symbol *sym{
1053	declScope.parent().FindSymbol(name->symbol->name())};
1054	if (sym &&
1055	(sym->has<MainProgramDetails>() ||
1056	sym->has<ModuleDetails>())) {
1057	context_.Say(name->source,
1058	"The module name or main program name cannot be in a "
1059	"%s "
1060	"directive"_err_en_US,
1061	ContextDirectiveAsFortran());
1062	} else if (!IsSaved(*name->symbol) &&
1063	declScope.kind() != Scope::Kind::MainProgram &&
1064	declScope.kind() != Scope::Kind::Module) {
1065	context_.Say(name->source,
1066	"A variable that appears in a %s directive must be "
1067	"declared in the scope of a module or have the SAVE "
1068	"attribute, either explicitly or "
1069	"implicitly"_err_en_US,
1070	ContextDirectiveAsFortran());
1071	} else if (useScope != declScope) {
1072	context_.Say(name->source,
1073	"The %s directive and the common block or variable "
1074	"in it must appear in the same declaration section "
1075	"of a scoping unit"_err_en_US,
1076	ContextDirectiveAsFortran());
1077	}
1078	}
1079	}
1080	}
1081	},
1082	[&](const parser::Name &) {}, // common block
1083	},
1084	ompObject.u);
1085	}
1086	}
1087
1088	void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
1089	const auto &dir{std::get<parser::Verbatim>(c.t)};
1090	PushContextAndClauseSets(
1091	dir.source, llvm::omp::Directive::OMPD_threadprivate);
1092	}
1093
1094	void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
1095	const auto &dir{std::get<parser::Verbatim>(c.t)};
1096	const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
1097	CheckSymbolNames(dir.source, objectList);
1098	CheckIsVarPartOfAnotherVar(dir.source, objectList);
1099	CheckThreadprivateOrDeclareTargetVar(objectList);
1100	dirContext_.pop_back();
1101	}
1102
1103	void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
1104	const auto &dir{std::get<parser::Verbatim>(x.t)};
1105	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
1106	}
1107
1108	void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
1109	dirContext_.pop_back();
1110	}
1111
1112	void OmpStructureChecker::Enter(const parser::OpenMPRequiresConstruct &x) {
1113	const auto &dir{std::get<parser::Verbatim>(x.t)};
1114	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_requires);
1115	}
1116
1117	void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
1118	dirContext_.pop_back();
1119	}
1120
1121	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
1122	isPredefinedAllocator = true;
1123	const auto &dir{std::get<parser::Verbatim>(x.t)};
1124	const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1125	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1126	CheckIsVarPartOfAnotherVar(dir.source, objectList);
1127	}
1128
1129	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
1130	const auto &dir{std::get<parser::Verbatim>(x.t)};
1131	const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1132	CheckPredefinedAllocatorRestriction(dir.source, objectList);
1133	dirContext_.pop_back();
1134	}
1135
1136	void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
1137	CheckAllowed(llvm::omp::Clause::OMPC_allocator);
1138	// Note: Predefined allocators are stored in ScalarExpr as numbers
1139	// whereas custom allocators are stored as strings, so if the ScalarExpr
1140	// actually has an int value, then it must be a predefined allocator
1141	isPredefinedAllocator = GetIntValue(x.v).has_value();
1142	RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
1143	}
1144
1145	void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {
1146	CheckAllowed(llvm::omp::Clause::OMPC_allocate);
1147	if (const auto &modifier{
1148	std::get<std::optional<parser::OmpAllocateClause::AllocateModifier>>(
1149	x.v.t)}) {
1150	common::visit(
1151	common::visitors{
1152	[&](const parser::OmpAllocateClause::AllocateModifier::Allocator
1153	&y) {
1154	RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocate, y.v);
1155	isPredefinedAllocator = GetIntValue(y.v).has_value();
1156	},
1157	[&](const parser::OmpAllocateClause::AllocateModifier::
1158	ComplexModifier &y) {
1159	const auto &alloc = std::get<
1160	parser::OmpAllocateClause::AllocateModifier::Allocator>(y.t);
1161	const auto &align =
1162	std::get<parser::OmpAllocateClause::AllocateModifier::Align>(
1163	y.t);
1164	RequiresPositiveParameter(
1165	llvm::omp::Clause::OMPC_allocate, alloc.v);
1166	RequiresPositiveParameter(
1167	llvm::omp::Clause::OMPC_allocate, align.v);
1168	isPredefinedAllocator = GetIntValue(alloc.v).has_value();
1169	},
1170	[&](const parser::OmpAllocateClause::AllocateModifier::Align &y) {
1171	RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocate, y.v);
1172	},
1173	},
1174	modifier->u);
1175	}
1176	}
1177
1178	void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithClause &x) {
1179	SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
1180	}
1181
1182	void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
1183	if (x.v.v.size() > 0) {
1184	const parser::OmpClause *enterClause =
1185	FindClause(llvm::omp::Clause::OMPC_enter);
1186	const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);
1187	const parser::OmpClause *linkClause =
1188	FindClause(llvm::omp::Clause::OMPC_link);
1189	if (!enterClause && !toClause && !linkClause) {
1190	context_.Say(x.source,
1191	"If the DECLARE TARGET directive has a clause, it must contain at lease one ENTER clause or LINK clause"_err_en_US);
1192	}
1193	if (toClause) {
1194	context_.Say(toClause->source,
1195	"The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);
1196	}
1197	}
1198	}
1199
1200	void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
1201	const auto &dir{std::get<parser::Verbatim>(x.t)};
1202	PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
1203	}
1204
1205	void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
1206	SymbolSourceMap symbols;
1207	GetSymbolsInObjectList(x.v, symbols);
1208	for (auto &[symbol, source] : symbols) {
1209	const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();
1210	if (genericDetails) {
1211	context_.Say(source,
1212	"The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,
1213	symbol->name());
1214	genericDetails->specific();
1215	}
1216	if (IsProcedurePointer(*symbol)) {
1217	context_.Say(source,
1218	"The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,
1219	symbol->name());
1220	}
1221	const SubprogramDetails *entryDetails =
1222	symbol->detailsIf<SubprogramDetails>();
1223	if (entryDetails && entryDetails->entryScope()) {
1224	context_.Say(source,
1225	"The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,
1226	symbol->name());
1227	}
1228	if (IsStmtFunction(*symbol)) {
1229	context_.Say(source,
1230	"The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,
1231	symbol->name());
1232	}
1233	}
1234	}
1235
1236	void OmpStructureChecker::CheckSymbolNames(
1237	const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1238	for (const auto &ompObject : objList.v) {
1239	common::visit(
1240	common::visitors{
1241	[&](const parser::Designator &designator) {
1242	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1243	if (!name->symbol) {
1244	context_.Say(source,
1245	"The given %s directive clause has an invalid argument"_err_en_US,
1246	ContextDirectiveAsFortran());
1247	}
1248	}
1249	},
1250	[&](const parser::Name &name) {
1251	if (!name.symbol) {
1252	context_.Say(source,
1253	"The given %s directive clause has an invalid argument"_err_en_US,
1254	ContextDirectiveAsFortran());
1255	}
1256	},
1257	},
1258	ompObject.u);
1259	}
1260	}
1261
1262	void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {
1263	const auto &dir{std::get<parser::Verbatim>(x.t)};
1264	const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1265	// Handle both forms of DECLARE TARGET.
1266	// - Extended list: It behaves as if there was an ENTER/TO clause with the
1267	// list of objects as argument. It accepts no explicit clauses.
1268	// - With clauses.
1269	if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1270	deviceConstructFound_ = true;
1271	CheckSymbolNames(dir.source, *objectList);
1272	CheckIsVarPartOfAnotherVar(dir.source, *objectList);
1273	CheckThreadprivateOrDeclareTargetVar(*objectList);
1274	} else if (const auto *clauseList{
1275	parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1276	bool toClauseFound{false}, deviceTypeClauseFound{false},
1277	enterClauseFound{false};
1278	for (const auto &clause : clauseList->v) {
1279	common::visit(
1280	common::visitors{
1281	[&](const parser::OmpClause::To &toClause) {
1282	toClauseFound = true;
1283	CheckSymbolNames(dir.source, toClause.v);
1284	CheckIsVarPartOfAnotherVar(dir.source, toClause.v);
1285	CheckThreadprivateOrDeclareTargetVar(toClause.v);
1286	},
1287	[&](const parser::OmpClause::Link &linkClause) {
1288	CheckSymbolNames(dir.source, linkClause.v);
1289	CheckIsVarPartOfAnotherVar(dir.source, linkClause.v);
1290	CheckThreadprivateOrDeclareTargetVar(linkClause.v);
1291	},
1292	[&](const parser::OmpClause::Enter &enterClause) {
1293	enterClauseFound = true;
1294	CheckSymbolNames(dir.source, enterClause.v);
1295	CheckIsVarPartOfAnotherVar(dir.source, enterClause.v);
1296	CheckThreadprivateOrDeclareTargetVar(enterClause.v);
1297	},
1298	[&](const parser::OmpClause::DeviceType &deviceTypeClause) {
1299	deviceTypeClauseFound = true;
1300	if (deviceTypeClause.v.v !=
1301	parser::OmpDeviceTypeClause::Type::Host) {
1302	// Function / subroutine explicitly marked as runnable by the
1303	// target device.
1304	deviceConstructFound_ = true;
1305	}
1306	},
1307	[&](const auto &) {},
1308	},
1309	clause.u);
1310
1311	if ((toClauseFound || enterClauseFound) && !deviceTypeClauseFound) {
1312	deviceConstructFound_ = true;
1313	}
1314	}
1315	}
1316	dirContext_.pop_back();
1317	}
1318
1319	void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
1320	isPredefinedAllocator = true;
1321	const auto &dir{std::get<parser::Verbatim>(x.t)};
1322	const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1323	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1324	if (objectList) {
1325	CheckIsVarPartOfAnotherVar(dir.source, *objectList);
1326	}
1327	}
1328
1329	void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
1330	const auto &dir{std::get<parser::Verbatim>(x.t)};
1331	const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1332	if (objectList)
1333	CheckPredefinedAllocatorRestriction(dir.source, *objectList);
1334	dirContext_.pop_back();
1335	}
1336
1337	void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
1338	isPredefinedAllocator = true;
1339	const auto &dir{std::get<parser::Verbatim>(x.t)};
1340	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocators);
1341	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1342	for (const auto &clause : clauseList.v) {
1343	if (const auto *allocClause{
1344	parser::Unwrap<parser::OmpClause::Allocate>(clause)}) {
1345	CheckIsVarPartOfAnotherVar(
1346	dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
1347	}
1348	}
1349	}
1350
1351	void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {
1352	const auto &dir{std::get<parser::Verbatim>(x.t)};
1353	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1354	for (const auto &clause : clauseList.v) {
1355	if (const auto *allocClause{
1356	std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
1357	CheckPredefinedAllocatorRestriction(
1358	dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
1359	}
1360	}
1361	dirContext_.pop_back();
1362	}
1363
1364	void OmpStructureChecker::CheckBarrierNesting(
1365	const parser::OpenMPSimpleStandaloneConstruct &x) {
1366	// A barrier region may not be `closely nested` inside a worksharing, loop,
1367	// task, taskloop, critical, ordered, atomic, or master region.
1368	// TODO: Expand the check to include `LOOP` construct as well when it is
1369	// supported.
1370	if (GetContext().directive == llvm::omp::Directive::OMPD_barrier) {
1371	if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
1372	context_.Say(parser::FindSourceLocation(x),
1373	"`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
1374	"`LOOP`, `TASK`, `TASKLOOP`,"
1375	"`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
1376	}
1377	}
1378	}
1379
1380	void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
1381	if (FindClause(llvm::omp::Clause::OMPC_threads) ||
1382	FindClause(llvm::omp::Clause::OMPC_simd)) {
1383	context_.Say(GetContext().clauseSource,
1384	"THREADS, SIMD clauses are not allowed when ORDERED construct is a "
1385	"standalone construct with no ORDERED region"_err_en_US);
1386	}
1387
1388	bool isSinkPresent{false};
1389	int dependSourceCount{0};
1390	auto clauseAll = FindClauses(llvm::omp::Clause::OMPC_depend);
1391	for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
1392	const auto &dependClause{
1393	std::get<parser::OmpClause::Depend>(itr->second->u)};
1394	if (std::get_if<parser::OmpDependClause::Source>(&dependClause.v.u)) {
1395	dependSourceCount++;
1396	if (isSinkPresent) {
1397	context_.Say(itr->second->source,
1398	"DEPEND(SOURCE) is not allowed when DEPEND(SINK: vec) is present "
1399	"on ORDERED directive"_err_en_US);
1400	}
1401	if (dependSourceCount > 1) {
1402	context_.Say(itr->second->source,
1403	"At most one DEPEND(SOURCE) clause can appear on the ORDERED "
1404	"directive"_err_en_US);
1405	}
1406	} else if (std::get_if<parser::OmpDependClause::Sink>(&dependClause.v.u)) {
1407	isSinkPresent = true;
1408	if (dependSourceCount > 0) {
1409	context_.Say(itr->second->source,
1410	"DEPEND(SINK: vec) is not allowed when DEPEND(SOURCE) is present "
1411	"on ORDERED directive"_err_en_US);
1412	}
1413	} else {
1414	context_.Say(itr->second->source,
1415	"Only DEPEND(SOURCE) or DEPEND(SINK: vec) are allowed when ORDERED "
1416	"construct is a standalone construct with no ORDERED "
1417	"region"_err_en_US);
1418	}
1419	}
1420
1421	bool isNestedInDoOrderedWithPara{false};
1422	if (CurrentDirectiveIsNested() &&
1423	llvm::omp::nestedOrderedDoAllowedSet.test(GetContextParent().directive)) {
1424	if (const auto *clause{
1425	FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) {
1426	const auto &orderedClause{
1427	std::get<parser::OmpClause::Ordered>(clause->u)};
1428	const auto orderedValue{GetIntValue(orderedClause.v)};
1429	if (orderedValue > 0) {
1430	isNestedInDoOrderedWithPara = true;
1431	CheckOrderedDependClause(orderedValue: orderedValue);
1432	}
1433	}
1434	}
1435
1436	if (FindClause(llvm::omp::Clause::OMPC_depend) &&
1437	!isNestedInDoOrderedWithPara) {
1438	context_.Say(GetContext().clauseSource,
1439	"An ORDERED construct with the DEPEND clause must be closely nested "
1440	"in a worksharing-loop (or parallel worksharing-loop) construct with "
1441	"ORDERED clause with a parameter"_err_en_US);
1442	}
1443	}
1444
1445	void OmpStructureChecker::CheckOrderedDependClause(
1446	std::optional<std::int64_t> orderedValue) {
1447	auto clauseAll{FindClauses(llvm::omp::Clause::OMPC_depend)};
1448	for (auto itr = clauseAll.first; itr != clauseAll.second; ++itr) {
1449	const auto &dependClause{
1450	std::get<parser::OmpClause::Depend>(itr->second->u)};
1451	if (const auto *sinkVectors{
1452	std::get_if<parser::OmpDependClause::Sink>(&dependClause.v.u)}) {
1453	std::int64_t numVar = sinkVectors->v.size();
1454	if (orderedValue != numVar) {
1455	context_.Say(itr->second->source,
1456	"The number of variables in DEPEND(SINK: vec) clause does not "
1457	"match the parameter specified in ORDERED clause"_err_en_US);
1458	}
1459	}
1460	}
1461	}
1462
1463	void OmpStructureChecker::CheckTargetUpdate() {
1464	const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);
1465	const parser::OmpClause *fromClause =
1466	FindClause(llvm::omp::Clause::OMPC_from);
1467	if (!toClause && !fromClause) {
1468	context_.Say(GetContext().directiveSource,
1469	"At least one motion-clause (TO/FROM) must be specified on TARGET UPDATE construct."_err_en_US);
1470	}
1471	if (toClause && fromClause) {
1472	SymbolSourceMap toSymbols, fromSymbols;
1473	GetSymbolsInObjectList(
1474	std::get<parser::OmpClause::To>(toClause->u).v, toSymbols);
1475	GetSymbolsInObjectList(
1476	std::get<parser::OmpClause::From>(fromClause->u).v, fromSymbols);
1477	for (auto &[symbol, source] : toSymbols) {
1478	auto fromSymbol = fromSymbols.find(symbol);
1479	if (fromSymbol != fromSymbols.end()) {
1480	context_.Say(source,
1481	"A list item ('%s') can only appear in a TO or FROM clause, but not in both."_err_en_US,
1482	symbol->name());
1483	context_.Say(source, "'%s' appears in the TO clause."_because_en_US,
1484	symbol->name());
1485	context_.Say(fromSymbol->second,
1486	"'%s' appears in the FROM clause."_because_en_US,
1487	fromSymbol->first->name());
1488	}
1489	}
1490	}
1491	}
1492
1493	void OmpStructureChecker::Enter(
1494	const parser::OpenMPSimpleStandaloneConstruct &x) {
1495	const auto &dir{std::get<parser::OmpSimpleStandaloneDirective>(x.t)};
1496	PushContextAndClauseSets(dir.source, dir.v);
1497	CheckBarrierNesting(x);
1498	}
1499
1500	void OmpStructureChecker::Leave(
1501	const parser::OpenMPSimpleStandaloneConstruct &x) {
1502	switch (GetContext().directive) {
1503	case llvm::omp::Directive::OMPD_ordered:
1504	// [5.1] 2.19.9 Ordered Construct Restriction
1505	ChecksOnOrderedAsStandalone();
1506	break;
1507	case llvm::omp::Directive::OMPD_target_update:
1508	CheckTargetUpdate();
1509	break;
1510	default:
1511	break;
1512	}
1513	dirContext_.pop_back();
1514	}
1515
1516	void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
1517	const auto &dir{std::get<parser::Verbatim>(x.t)};
1518	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_flush);
1519	}
1520
1521	void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
1522	if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
1523	FindClause(llvm::omp::Clause::OMPC_release) ||
1524	FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
1525	if (const auto &flushList{
1526	std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
1527	context_.Say(parser::FindSourceLocation(flushList),
1528	"If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items "
1529	"must not be specified on the FLUSH directive"_err_en_US);
1530	}
1531	}
1532	dirContext_.pop_back();
1533	}
1534
1535	void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
1536	const auto &dir{std::get<parser::Verbatim>(x.t)};
1537	const auto &type{std::get<parser::OmpCancelType>(x.t)};
1538	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_cancel);
1539	CheckCancellationNest(dir.source, type.v);
1540	}
1541
1542	void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
1543	dirContext_.pop_back();
1544	}
1545
1546	void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
1547	const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
1548	const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
1549	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical);
1550	const auto &block{std::get<parser::Block>(x.t)};
1551	CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
1552	const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
1553	const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
1554	const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)};
1555	if (dirName && endDirName &&
1556	dirName->ToString().compare(endDirName->ToString())) {
1557	context_
1558	.Say(endDirName->source,
1559	parser::MessageFormattedText{
1560	"CRITICAL directive names do not match"_err_en_US})
1561	.Attach(dirName->source, "should be "_en_US);
1562	} else if (dirName && !endDirName) {
1563	context_
1564	.Say(dirName->source,
1565	parser::MessageFormattedText{
1566	"CRITICAL directive names do not match"_err_en_US})
1567	.Attach(dirName->source, "should be NULL"_en_US);
1568	} else if (!dirName && endDirName) {
1569	context_
1570	.Say(endDirName->source,
1571	parser::MessageFormattedText{
1572	"CRITICAL directive names do not match"_err_en_US})
1573	.Attach(endDirName->source, "should be NULL"_en_US);
1574	}
1575	if (!dirName && !ompClause.source.empty() &&
1576	ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") {
1577	context_.Say(dir.source,
1578	parser::MessageFormattedText{
1579	"Hint clause other than omp_sync_hint_none cannot be specified for "
1580	"an unnamed CRITICAL directive"_err_en_US});
1581	}
1582	CheckHintClause<const parser::OmpClauseList>(&ompClause, nullptr);
1583	}
1584
1585	void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
1586	dirContext_.pop_back();
1587	}
1588
1589	void OmpStructureChecker::Enter(
1590	const parser::OpenMPCancellationPointConstruct &x) {
1591	const auto &dir{std::get<parser::Verbatim>(x.t)};
1592	const auto &type{std::get<parser::OmpCancelType>(x.t)};
1593	PushContextAndClauseSets(
1594	dir.source, llvm::omp::Directive::OMPD_cancellation_point);
1595	CheckCancellationNest(dir.source, type.v);
1596	}
1597
1598	void OmpStructureChecker::Leave(
1599	const parser::OpenMPCancellationPointConstruct &) {
1600	dirContext_.pop_back();
1601	}
1602
1603	void OmpStructureChecker::CheckCancellationNest(
1604	const parser::CharBlock &source, const parser::OmpCancelType::Type &type) {
1605	if (CurrentDirectiveIsNested()) {
1606	// If construct-type-clause is taskgroup, the cancellation construct must be
1607	// closely nested inside a task or a taskloop construct and the cancellation
1608	// region must be closely nested inside a taskgroup region. If
1609	// construct-type-clause is sections, the cancellation construct must be
1610	// closely nested inside a sections or section construct. Otherwise, the
1611	// cancellation construct must be closely nested inside an OpenMP construct
1612	// that matches the type specified in construct-type-clause of the
1613	// cancellation construct.
1614	bool eligibleCancellation{false};
1615	switch (type) {
1616	case parser::OmpCancelType::Type::Taskgroup:
1617	if (llvm::omp::nestedCancelTaskgroupAllowedSet.test(
1618	GetContextParent().directive)) {
1619	eligibleCancellation = true;
1620	if (dirContext_.size() >= 3) {
1621	// Check if the cancellation region is closely nested inside a
1622	// taskgroup region when there are more than two levels of directives
1623	// in the directive context stack.
1624	if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
1625	FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
1626	for (int i = dirContext_.size() - 3; i >= 0; i--) {
1627	if (dirContext_[i].directive ==
1628	llvm::omp::Directive::OMPD_taskgroup) {
1629	break;
1630	}
1631	if (llvm::omp::nestedCancelParallelAllowedSet.test(
1632	dirContext_[i].directive)) {
1633	eligibleCancellation = false;
1634	break;
1635	}
1636	}
1637	}
1638	}
1639	}
1640	if (!eligibleCancellation) {
1641	context_.Say(source,
1642	"With %s clause, %s construct must be closely nested inside TASK "
1643	"or TASKLOOP construct and %s region must be closely nested inside "
1644	"TASKGROUP region"_err_en_US,
1645	parser::ToUpperCaseLetters(
1646	parser::OmpCancelType::EnumToString(type)),
1647	ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
1648	}
1649	return;
1650	case parser::OmpCancelType::Type::Sections:
1651	if (llvm::omp::nestedCancelSectionsAllowedSet.test(
1652	GetContextParent().directive)) {
1653	eligibleCancellation = true;
1654	}
1655	break;
1656	case Fortran::parser::OmpCancelType::Type::Do:
1657	if (llvm::omp::nestedCancelDoAllowedSet.test(
1658	GetContextParent().directive)) {
1659	eligibleCancellation = true;
1660	}
1661	break;
1662	case parser::OmpCancelType::Type::Parallel:
1663	if (llvm::omp::nestedCancelParallelAllowedSet.test(
1664	GetContextParent().directive)) {
1665	eligibleCancellation = true;
1666	}
1667	break;
1668	}
1669	if (!eligibleCancellation) {
1670	context_.Say(source,
1671	"With %s clause, %s construct cannot be closely nested inside %s "
1672	"construct"_err_en_US,
1673	parser::ToUpperCaseLetters(parser::OmpCancelType::EnumToString(type)),
1674	ContextDirectiveAsFortran(),
1675	parser::ToUpperCaseLetters(
1676	getDirectiveName(GetContextParent().directive).str()));
1677	}
1678	} else {
1679	// The cancellation directive cannot be orphaned.
1680	switch (type) {
1681	case parser::OmpCancelType::Type::Taskgroup:
1682	context_.Say(source,
1683	"%s %s directive is not closely nested inside "
1684	"TASK or TASKLOOP"_err_en_US,
1685	ContextDirectiveAsFortran(),
1686	parser::ToUpperCaseLetters(
1687	parser::OmpCancelType::EnumToString(type)));
1688	break;
1689	case parser::OmpCancelType::Type::Sections:
1690	context_.Say(source,
1691	"%s %s directive is not closely nested inside "
1692	"SECTION or SECTIONS"_err_en_US,
1693	ContextDirectiveAsFortran(),
1694	parser::ToUpperCaseLetters(
1695	parser::OmpCancelType::EnumToString(type)));
1696	break;
1697	case Fortran::parser::OmpCancelType::Type::Do:
1698	context_.Say(source,
1699	"%s %s directive is not closely nested inside "
1700	"the construct that matches the DO clause type"_err_en_US,
1701	ContextDirectiveAsFortran(),
1702	parser::ToUpperCaseLetters(
1703	parser::OmpCancelType::EnumToString(type)));
1704	break;
1705	case parser::OmpCancelType::Type::Parallel:
1706	context_.Say(source,
1707	"%s %s directive is not closely nested inside "
1708	"the construct that matches the PARALLEL clause type"_err_en_US,
1709	ContextDirectiveAsFortran(),
1710	parser::ToUpperCaseLetters(
1711	parser::OmpCancelType::EnumToString(type)));
1712	break;
1713	}
1714	}
1715	}
1716
1717	void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
1718	const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
1719	ResetPartialContext(dir.source);
1720	switch (dir.v) {
1721	// 2.7.3 end-single-clause -> copyprivate-clause |
1722	// nowait-clause
1723	case llvm::omp::Directive::OMPD_single:
1724	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
1725	break;
1726	// 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
1727	case llvm::omp::Directive::OMPD_workshare:
1728	PushContextAndClauseSets(
1729	dir.source, llvm::omp::Directive::OMPD_end_workshare);
1730	break;
1731	default:
1732	// no clauses are allowed
1733	break;
1734	}
1735	}
1736
1737	// TODO: Verify the popping of dirContext requirement after nowait
1738	// implementation, as there is an implicit barrier at the end of the worksharing
1739	// constructs unless a nowait clause is specified. Only OMPD_end_single and
1740	// end_workshareare popped as they are pushed while entering the
1741	// EndBlockDirective.
1742	void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
1743	if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
1744	(GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
1745	dirContext_.pop_back();
1746	}
1747	}
1748
1749	inline void OmpStructureChecker::ErrIfAllocatableVariable(
1750	const parser::Variable &var) {
1751	// Err out if the given symbol has
1752	// ALLOCATABLE attribute
1753	if (const auto *e{GetExpr(context_, var)})
1754	for (const Symbol &symbol : evaluate::CollectSymbols(*e))
1755	if (IsAllocatable(symbol)) {
1756	const auto &designator =
1757	std::get<common::Indirection<parser::Designator>>(var.u);
1758	const auto *dataRef =
1759	std::get_if<Fortran::parser::DataRef>(&designator.value().u);
1760	const Fortran::parser::Name *name =
1761	dataRef ? std::get_if<Fortran::parser::Name>(&dataRef->u) : nullptr;
1762	if (name)
1763	context_.Say(name->source,
1764	"%s must not have ALLOCATABLE "
1765	"attribute"_err_en_US,
1766	name->ToString());
1767	}
1768	}
1769
1770	inline void OmpStructureChecker::ErrIfLHSAndRHSSymbolsMatch(
1771	const parser::Variable &var, const parser::Expr &expr) {
1772	// Err out if the symbol on the LHS is also used on the RHS of the assignment
1773	// statement
1774	const auto *e{GetExpr(context_, expr)};
1775	const auto *v{GetExpr(context_, var)};
1776	if (e && v) {
1777	const Symbol &varSymbol = evaluate::GetSymbolVector(*v).front();
1778	for (const Symbol &symbol : evaluate::GetSymbolVector(*e)) {
1779	if (varSymbol == symbol) {
1780	context_.Say(expr.source,
1781	"RHS expression "
1782	"on atomic assignment statement"
1783	" cannot access '%s'"_err_en_US,
1784	var.GetSource().ToString());
1785	}
1786	}
1787	}
1788	}
1789
1790	inline void OmpStructureChecker::ErrIfNonScalarAssignmentStmt(
1791	const parser::Variable &var, const parser::Expr &expr) {
1792	// Err out if either the variable on the LHS or the expression on the RHS of
1793	// the assignment statement are non-scalar (i.e. have rank > 0)
1794	const auto *e{GetExpr(context_, expr)};
1795	const auto *v{GetExpr(context_, var)};
1796	if (e && v) {
1797	if (e->Rank() != 0)
1798	context_.Say(expr.source,
1799	"Expected scalar expression "
1800	"on the RHS of atomic assignment "
1801	"statement"_err_en_US);
1802	if (v->Rank() != 0)
1803	context_.Say(var.GetSource(),
1804	"Expected scalar variable "
1805	"on the LHS of atomic assignment "
1806	"statement"_err_en_US);
1807	}
1808	}
1809
1810	template <typename T, typename D>
1811	bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) {
1812	using AllowedBinaryOperators =
1813	std::variant<parser::Expr::Add, parser::Expr::Multiply,
1814	parser::Expr::Subtract, parser::Expr::Divide, parser::Expr::AND,
1815	parser::Expr::OR, parser::Expr::EQV, parser::Expr::NEQV>;
1816	using BinaryOperators = std::variant<parser::Expr::Add,
1817	parser::Expr::Multiply, parser::Expr::Subtract, parser::Expr::Divide,
1818	parser::Expr::AND, parser::Expr::OR, parser::Expr::EQV,
1819	parser::Expr::NEQV, parser::Expr::Power, parser::Expr::Concat,
1820	parser::Expr::LT, parser::Expr::LE, parser::Expr::EQ, parser::Expr::NE,
1821	parser::Expr::GE, parser::Expr::GT>;
1822
1823	if constexpr (common::HasMember<T, BinaryOperators>) {
1824	const auto &variableName{variable.GetSource().ToString()};
1825	const auto &exprLeft{std::get<0>(node.t)};
1826	const auto &exprRight{std::get<1>(node.t)};
1827	if ((exprLeft.value().source.ToString() != variableName) &&
1828	(exprRight.value().source.ToString() != variableName)) {
1829	context_.Say(variable.GetSource(),
1830	"Atomic update statement should be of form "
1831	"`%s = %s operator expr` OR `%s = expr operator %s`"_err_en_US,
1832	variableName, variableName, variableName, variableName);
1833	}
1834	return common::HasMember<T, AllowedBinaryOperators>;
1835	}
1836	return false;
1837	}
1838
1839	void OmpStructureChecker::CheckAtomicCaptureStmt(
1840	const parser::AssignmentStmt &assignmentStmt) {
1841	const auto &var{std::get<parser::Variable>(assignmentStmt.t)};
1842	const auto &expr{std::get<parser::Expr>(assignmentStmt.t)};
1843	common::visit(
1844	common::visitors{
1845	[&](const common::Indirection<parser::Designator> &designator) {
1846	const auto *dataRef =
1847	std::get_if<Fortran::parser::DataRef>(&designator.value().u);
1848	const auto *name = dataRef
1849	? std::get_if<Fortran::parser::Name>(&dataRef->u)
1850	: nullptr;
1851	if (name && IsAllocatable(*name->symbol))
1852	context_.Say(name->source,
1853	"%s must not have ALLOCATABLE "
1854	"attribute"_err_en_US,
1855	name->ToString());
1856	},
1857	[&](const auto &) {
1858	// Anything other than a `parser::Designator` is not allowed
1859	context_.Say(expr.source,
1860	"Expected scalar variable "
1861	"of intrinsic type on RHS of atomic "
1862	"assignment statement"_err_en_US);
1863	}},
1864	expr.u);
1865	ErrIfLHSAndRHSSymbolsMatch(var, expr);
1866	ErrIfNonScalarAssignmentStmt(var, expr);
1867	}
1868
1869	void OmpStructureChecker::CheckAtomicWriteStmt(
1870	const parser::AssignmentStmt &assignmentStmt) {
1871	const auto &var{std::get<parser::Variable>(assignmentStmt.t)};
1872	const auto &expr{std::get<parser::Expr>(assignmentStmt.t)};
1873	ErrIfAllocatableVariable(var);
1874	ErrIfLHSAndRHSSymbolsMatch(var, expr);
1875	ErrIfNonScalarAssignmentStmt(var, expr);
1876	}
1877
1878	void OmpStructureChecker::CheckAtomicUpdateStmt(
1879	const parser::AssignmentStmt &assignment) {
1880	const auto &expr{std::get<parser::Expr>(assignment.t)};
1881	const auto &var{std::get<parser::Variable>(assignment.t)};
1882	bool isIntrinsicProcedure{false};
1883	bool isValidOperator{false};
1884	common::visit(
1885	common::visitors{
1886	[&](const common::Indirection<parser::FunctionReference> &x) {
1887	isIntrinsicProcedure = true;
1888	const auto &procedureDesignator{
1889	std::get<parser::ProcedureDesignator>(x.value().v.t)};
1890	const parser::Name *name{
1891	std::get_if<parser::Name>(&procedureDesignator.u)};
1892	if (name &&
1893	!(name->source == "max" || name->source == "min" ||
1894	name->source == "iand" || name->source == "ior" ||
1895	name->source == "ieor")) {
1896	context_.Say(expr.source,
1897	"Invalid intrinsic procedure name in "
1898	"OpenMP ATOMIC (UPDATE) statement"_err_en_US);
1899	}
1900	},
1901	[&](const auto &x) {
1902	if (!IsOperatorValid(x, var)) {
1903	context_.Say(expr.source,
1904	"Invalid or missing operator in atomic update "
1905	"statement"_err_en_US);
1906	} else
1907	isValidOperator = true;
1908	},
1909	},
1910	expr.u);
1911	if (const auto *e{GetExpr(context_, expr)}) {
1912	const auto *v{GetExpr(context_, var)};
1913	if (e->Rank() != 0)
1914	context_.Say(expr.source,
1915	"Expected scalar expression "
1916	"on the RHS of atomic update assignment "
1917	"statement"_err_en_US);
1918	if (v->Rank() != 0)
1919	context_.Say(var.GetSource(),
1920	"Expected scalar variable "
1921	"on the LHS of atomic update assignment "
1922	"statement"_err_en_US);
1923	const Symbol &varSymbol = evaluate::GetSymbolVector(*v).front();
1924	int numOfSymbolMatches{0};
1925	SymbolVector exprSymbols = evaluate::GetSymbolVector(*e);
1926	for (const Symbol &symbol : exprSymbols) {
1927	if (varSymbol == symbol)
1928	numOfSymbolMatches++;
1929	}
1930	if (isIntrinsicProcedure) {
1931	std::string varName = var.GetSource().ToString();
1932	if (numOfSymbolMatches != 1)
1933	context_.Say(expr.source,
1934	"Intrinsic procedure"
1935	" arguments in atomic update statement"
1936	" must have exactly one occurence of '%s'"_err_en_US,
1937	varName);
1938	else if (varSymbol != exprSymbols.front() &&
1939	varSymbol != exprSymbols.back())
1940	context_.Say(expr.source,
1941	"Atomic update statement "
1942	"should be of the form `%s = intrinsic_procedure(%s, expr_list)` "
1943	"OR `%s = intrinsic_procedure(expr_list, %s)`"_err_en_US,
1944	varName, varName, varName, varName);
1945	} else if (isValidOperator) {
1946	if (numOfSymbolMatches != 1)
1947	context_.Say(expr.source,
1948	"Exactly one occurence of '%s' "
1949	"expected on the RHS of atomic update assignment statement"_err_en_US,
1950	var.GetSource().ToString());
1951	}
1952	}
1953
1954	ErrIfAllocatableVariable(var);
1955	}
1956
1957	void OmpStructureChecker::CheckAtomicMemoryOrderClause(
1958	const parser::OmpAtomicClauseList *leftHandClauseList,
1959	const parser::OmpAtomicClauseList *rightHandClauseList) {
1960	int numMemoryOrderClause = 0;
1961	auto checkForValidMemoryOrderClause =
1962	[&](const parser::OmpAtomicClauseList *clauseList) {
1963	for (const auto &clause : clauseList->v) {
1964	if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u)) {
1965	numMemoryOrderClause++;
1966	if (numMemoryOrderClause > 1) {
1967	context_.Say(clause.source,
1968	"More than one memory order clause not allowed on "
1969	"OpenMP Atomic construct"_err_en_US);
1970	return;
1971	}
1972	}
1973	}
1974	};
1975	if (leftHandClauseList) {
1976	checkForValidMemoryOrderClause(leftHandClauseList);
1977	}
1978	if (rightHandClauseList) {
1979	checkForValidMemoryOrderClause(rightHandClauseList);
1980	}
1981	}
1982
1983	void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
1984	common::visit(
1985	common::visitors{
1986	[&](const parser::OmpAtomic &atomicConstruct) {
1987	const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)};
1988	PushContextAndClauseSets(
1989	dir.source, llvm::omp::Directive::OMPD_atomic);
1990	CheckAtomicUpdateStmt(
1991	std::get<parser::Statement<parser::AssignmentStmt>>(
1992	atomicConstruct.t)
1993	.statement);
1994	CheckAtomicMemoryOrderClause(
1995	&std::get<parser::OmpAtomicClauseList>(atomicConstruct.t),
1996	nullptr);
1997	CheckHintClause<const parser::OmpAtomicClauseList>(
1998	&std::get<parser::OmpAtomicClauseList>(atomicConstruct.t),
1999	nullptr);
2000	},
2001	[&](const parser::OmpAtomicUpdate &atomicUpdate) {
2002	const auto &dir{std::get<parser::Verbatim>(atomicUpdate.t)};
2003	PushContextAndClauseSets(
2004	dir.source, llvm::omp::Directive::OMPD_atomic);
2005	CheckAtomicUpdateStmt(
2006	std::get<parser::Statement<parser::AssignmentStmt>>(
2007	atomicUpdate.t)
2008	.statement);
2009	CheckAtomicMemoryOrderClause(
2010	&std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t));
2011	CheckHintClause<const parser::OmpAtomicClauseList>(
2012	&std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t));
2013	},
2014	[&](const parser::OmpAtomicRead &atomicRead) {
2015	const auto &dir{std::get<parser::Verbatim>(atomicRead.t)};
2016	PushContextAndClauseSets(
2017	dir.source, llvm::omp::Directive::OMPD_atomic);
2018	CheckAtomicMemoryOrderClause(
2019	&std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t));
2020	CheckHintClause<const parser::OmpAtomicClauseList>(
2021	&std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t));
2022	CheckAtomicCaptureStmt(
2023	std::get<parser::Statement<parser::AssignmentStmt>>(
2024	atomicRead.t)
2025	.statement);
2026	},
2027	[&](const parser::OmpAtomicWrite &atomicWrite) {
2028	const auto &dir{std::get<parser::Verbatim>(atomicWrite.t)};
2029	PushContextAndClauseSets(
2030	dir.source, llvm::omp::Directive::OMPD_atomic);
2031	CheckAtomicMemoryOrderClause(
2032	&std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t));
2033	CheckHintClause<const parser::OmpAtomicClauseList>(
2034	&std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t));
2035	CheckAtomicWriteStmt(
2036	std::get<parser::Statement<parser::AssignmentStmt>>(
2037	atomicWrite.t)
2038	.statement);
2039	},
2040	[&](const auto &atomicConstruct) {
2041	const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t)};
2042	PushContextAndClauseSets(
2043	dir.source, llvm::omp::Directive::OMPD_atomic);
2044	CheckAtomicMemoryOrderClause(&std::get<0>(atomicConstruct.t),
2045	&std::get<2>(atomicConstruct.t));
2046	CheckHintClause<const parser::OmpAtomicClauseList>(
2047	&std::get<0>(atomicConstruct.t),
2048	&std::get<2>(atomicConstruct.t));
2049	},
2050	},
2051	x.u);
2052	}
2053
2054	void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
2055	dirContext_.pop_back();
2056	}
2057
2058	// Clauses
2059	// Mainly categorized as
2060	// 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
2061	// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
2062	// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
2063
2064	void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
2065	// 2.7.1 Loop Construct Restriction
2066	if (llvm::omp::allDoSet.test(GetContext().directive)) {
2067	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
2068	// only one schedule clause is allowed
2069	const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
2070	if (ScheduleModifierHasType(schedClause.v,
2071	parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
2072	if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
2073	context_.Say(clause->source,
2074	"The NONMONOTONIC modifier cannot be specified "
2075	"if an ORDERED clause is specified"_err_en_US);
2076	}
2077	if (ScheduleModifierHasType(schedClause.v,
2078	parser::OmpScheduleModifierType::ModType::Monotonic)) {
2079	context_.Say(clause->source,
2080	"The MONOTONIC and NONMONOTONIC modifiers "
2081	"cannot be both specified"_err_en_US);
2082	}
2083	}
2084	}
2085
2086	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
2087	// only one ordered clause is allowed
2088	const auto &orderedClause{
2089	std::get<parser::OmpClause::Ordered>(clause->u)};
2090
2091	if (orderedClause.v) {
2092	CheckNotAllowedIfClause(
2093	llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
2094
2095	if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
2096	const auto &collapseClause{
2097	std::get<parser::OmpClause::Collapse>(clause2->u)};
2098	// ordered and collapse both have parameters
2099	if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
2100	if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
2101	if (*orderedValue > 0 && *orderedValue < *collapseValue) {
2102	context_.Say(clause->source,
2103	"The parameter of the ORDERED clause must be "
2104	"greater than or equal to "
2105	"the parameter of the COLLAPSE clause"_err_en_US);
2106	}
2107	}
2108	}
2109	}
2110	}
2111
2112	// TODO: ordered region binding check (requires nesting implementation)
2113	}
2114	} // doSet
2115
2116	// 2.8.1 Simd Construct Restriction
2117	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
2118	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
2119	if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
2120	const auto &simdlenClause{
2121	std::get<parser::OmpClause::Simdlen>(clause->u)};
2122	const auto &safelenClause{
2123	std::get<parser::OmpClause::Safelen>(clause2->u)};
2124	// simdlen and safelen both have parameters
2125	if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
2126	if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
2127	if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
2128	context_.Say(clause->source,
2129	"The parameter of the SIMDLEN clause must be less than or "
2130	"equal to the parameter of the SAFELEN clause"_err_en_US);
2131	}
2132	}
2133	}
2134	}
2135	}
2136	// Sema checks related to presence of multiple list items within the same
2137	// clause
2138	CheckMultListItems();
2139	} // SIMD
2140
2141	// 2.7.3 Single Construct Restriction
2142	if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) {
2143	CheckNotAllowedIfClause(
2144	llvm::omp::Clause::OMPC_copyprivate, {llvm::omp::Clause::OMPC_nowait});
2145	}
2146
2147	auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name,
2148	llvmOmpClause clauseTy) {
2149	if (sym.test(Symbol::Flag::OmpThreadprivate))
2150	context_.Say(name.source,
2151	"A THREADPRIVATE variable cannot be in %s clause"_err_en_US,
2152	parser::ToUpperCaseLetters(getClauseName(clauseTy).str()));
2153	};
2154
2155	// [5.1] 2.21.2 Threadprivate Directive Restriction
2156	OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin,
2157	llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule,
2158	llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit,
2159	llvm::omp::Clause::OMPC_if};
2160	for (auto it : GetContext().clauseInfo) {
2161	llvmOmpClause type = it.first;
2162	const auto *clause = it.second;
2163	if (!threadprivateAllowedSet.test(type)) {
2164	if (const auto *objList{GetOmpObjectList(*clause)}) {
2165	for (const auto &ompObject : objList->v) {
2166	common::visit(
2167	common::visitors{
2168	[&](const parser::Designator &) {
2169	if (const auto *name{
2170	parser::Unwrap<parser::Name>(ompObject)}) {
2171	if (name->symbol) {
2172	testThreadprivateVarErr(
2173	name->symbol->GetUltimate(), *name, type);
2174	}
2175	}
2176	},
2177	[&](const parser::Name &name) {
2178	if (name.symbol) {
2179	for (const auto &mem :
2180	name.symbol->get<CommonBlockDetails>().objects()) {
2181	testThreadprivateVarErr(mem->GetUltimate(), name, type);
2182	break;
2183	}
2184	}
2185	},
2186	},
2187	ompObject.u);
2188	}
2189	}
2190	}
2191	}
2192
2193	CheckRequireAtLeastOneOf();
2194	}
2195
2196	void OmpStructureChecker::Enter(const parser::OmpClause &x) {
2197	SetContextClause(x);
2198	}
2199
2200	// Following clauses do not have a separate node in parse-tree.h.
2201	CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
2202	CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
2203	CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
2204	CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
2205	CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
2206	CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
2207	CHECK_SIMPLE_CLAUSE(Destroy, OMPC_destroy)
2208	CHECK_SIMPLE_CLAUSE(Detach, OMPC_detach)
2209	CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
2210	CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
2211	CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
2212	CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
2213	CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
2214	CHECK_SIMPLE_CLAUSE(From, OMPC_from)
2215	CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
2216	CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint)
2217	CHECK_SIMPLE_CLAUSE(InReduction, OMPC_in_reduction)
2218	CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
2219	CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
2220	CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
2221	CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
2222	CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
2223	CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
2224	CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
2225	CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
2226	CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
2227	CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect)
2228	CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
2229	CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
2230	CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
2231	CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
2232	CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
2233	CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
2234	CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
2235	CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
2236	CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
2237	CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
2238	CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
2239	CHECK_SIMPLE_CLAUSE(To, OMPC_to)
2240	CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
2241	CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
2242	CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
2243	CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
2244	CHECK_SIMPLE_CLAUSE(Update, OMPC_update)
2245	CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
2246	CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
2247	CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
2248	CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
2249	CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
2250	CHECK_SIMPLE_CLAUSE(At, OMPC_at)
2251	CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
2252	CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
2253	CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
2254	CHECK_SIMPLE_CLAUSE(When, OMPC_when)
2255	CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)
2256	CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)
2257	CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)
2258	CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)
2259	CHECK_SIMPLE_CLAUSE(Align, OMPC_align)
2260	CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)
2261	CHECK_SIMPLE_CLAUSE(CancellationConstructType, OMPC_cancellation_construct_type)
2262	CHECK_SIMPLE_CLAUSE(Doacross, OMPC_doacross)
2263	CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)
2264	CHECK_SIMPLE_CLAUSE(OmpxBare, OMPC_ompx_bare)
2265	CHECK_SIMPLE_CLAUSE(Enter, OMPC_enter)
2266	CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)
2267	CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak)
2268
2269	CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize)
2270	CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks)
2271	CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
2272	CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
2273	CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem)
2274	CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
2275	CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
2276
2277	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
2278	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
2279	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
2280
2281	// Restrictions specific to each clause are implemented apart from the
2282	// generalized restrictions.
2283	void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
2284	CheckAllowed(llvm::omp::Clause::OMPC_reduction);
2285	if (CheckReductionOperators(x)) {
2286	CheckReductionTypeList(x);
2287	}
2288	}
2289
2290	bool OmpStructureChecker::CheckReductionOperators(
2291	const parser::OmpClause::Reduction &x) {
2292
2293	const auto &definedOp{std::get<parser::OmpReductionOperator>(x.v.t)};
2294	bool ok = false;
2295	common::visit(
2296	common::visitors{
2297	[&](const parser::DefinedOperator &dOpr) {
2298	const auto &intrinsicOp{
2299	std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
2300	ok = CheckIntrinsicOperator(intrinsicOp);
2301	},
2302	[&](const parser::ProcedureDesignator &procD) {
2303	const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
2304	if (name && name->symbol) {
2305	const SourceName &realName{name->symbol->GetUltimate().name()};
2306	if (realName == "max" || realName == "min" ||
2307	realName == "iand" || realName == "ior" ||
2308	realName == "ieor") {
2309	ok = true;
2310	}
2311	}
2312	if (!ok) {
2313	context_.Say(GetContext().clauseSource,
2314	"Invalid reduction identifier in REDUCTION "
2315	"clause."_err_en_US,
2316	ContextDirectiveAsFortran());
2317	}
2318	},
2319	},
2320	definedOp.u);
2321
2322	return ok;
2323	}
2324	bool OmpStructureChecker::CheckIntrinsicOperator(
2325	const parser::DefinedOperator::IntrinsicOperator &op) {
2326
2327	switch (op) {
2328	case parser::DefinedOperator::IntrinsicOperator::Add:
2329	case parser::DefinedOperator::IntrinsicOperator::Multiply:
2330	case parser::DefinedOperator::IntrinsicOperator::AND:
2331	case parser::DefinedOperator::IntrinsicOperator::OR:
2332	case parser::DefinedOperator::IntrinsicOperator::EQV:
2333	case parser::DefinedOperator::IntrinsicOperator::NEQV:
2334	return true;
2335	case parser::DefinedOperator::IntrinsicOperator::Subtract:
2336	context_.Say(GetContext().clauseSource,
2337	"The minus reduction operator is deprecated since OpenMP 5.2 and is "
2338	"not supported in the REDUCTION clause."_err_en_US,
2339	ContextDirectiveAsFortran());
2340	break;
2341	default:
2342	context_.Say(GetContext().clauseSource,
2343	"Invalid reduction operator in REDUCTION clause."_err_en_US,
2344	ContextDirectiveAsFortran());
2345	}
2346	return false;
2347	}
2348
2349	void OmpStructureChecker::CheckReductionTypeList(
2350	const parser::OmpClause::Reduction &x) {
2351	const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
2352	CheckIntentInPointerAndDefinable(
2353	ompObjectList, llvm::omp::Clause::OMPC_reduction);
2354	CheckReductionArraySection(ompObjectList);
2355	// If this is a worksharing construct then ensure the reduction variable
2356	// is not private in the parallel region that it binds to.
2357	if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) {
2358	CheckSharedBindingInOuterContext(ompObjectList);
2359	}
2360
2361	SymbolSourceMap symbols;
2362	GetSymbolsInObjectList(ompObjectList, symbols);
2363	for (auto &[symbol, source] : symbols) {
2364	if (IsProcedurePointer(*symbol)) {
2365	context_.Say(source,
2366	"A procedure pointer '%s' must not appear in a REDUCTION clause."_err_en_US,
2367	symbol->name());
2368	}
2369	}
2370	}
2371
2372	void OmpStructureChecker::CheckIntentInPointerAndDefinable(
2373	const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
2374	for (const auto &ompObject : objectList.v) {
2375	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2376	if (const auto *symbol{name->symbol}) {
2377	if (IsPointer(symbol->GetUltimate()) &&
2378	IsIntentIn(symbol->GetUltimate())) {
2379	context_.Say(GetContext().clauseSource,
2380	"Pointer '%s' with the INTENT(IN) attribute may not appear "
2381	"in a %s clause"_err_en_US,
2382	symbol->name(),
2383	parser::ToUpperCaseLetters(getClauseName(clause).str()));
2384	} else if (auto msg{WhyNotDefinable(name->source,
2385	context_.FindScope(name->source), DefinabilityFlags{},
2386	*symbol)}) {
2387	context_
2388	.Say(GetContext().clauseSource,
2389	"Variable '%s' on the %s clause is not definable"_err_en_US,
2390	symbol->name(),
2391	parser::ToUpperCaseLetters(getClauseName(clause).str()))
2392	.Attach(std::move(*msg));
2393	}
2394	}
2395	}
2396	}
2397	}
2398
2399	void OmpStructureChecker::CheckReductionArraySection(
2400	const parser::OmpObjectList &ompObjectList) {
2401	for (const auto &ompObject : ompObjectList.v) {
2402	if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
2403	if (const auto *arrayElement{
2404	parser::Unwrap<parser::ArrayElement>(ompObject)}) {
2405	if (arrayElement) {
2406	CheckArraySection(*arrayElement, GetLastName(*dataRef),
2407	llvm::omp::Clause::OMPC_reduction);
2408	}
2409	}
2410	}
2411	}
2412	}
2413
2414	void OmpStructureChecker::CheckSharedBindingInOuterContext(
2415	const parser::OmpObjectList &redObjectList) {
2416	// TODO: Verify the assumption here that the immediately enclosing region is
2417	// the parallel region to which the worksharing construct having reduction
2418	// binds to.
2419	if (auto *enclosingContext{GetEnclosingDirContext()}) {
2420	for (auto it : enclosingContext->clauseInfo) {
2421	llvmOmpClause type = it.first;
2422	const auto *clause = it.second;
2423	if (llvm::omp::privateReductionSet.test(type)) {
2424	if (const auto *objList{GetOmpObjectList(*clause)}) {
2425	for (const auto &ompObject : objList->v) {
2426	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2427	if (const auto *symbol{name->symbol}) {
2428	for (const auto &redOmpObject : redObjectList.v) {
2429	if (const auto *rname{
2430	parser::Unwrap<parser::Name>(redOmpObject)}) {
2431	if (const auto *rsymbol{rname->symbol}) {
2432	if (rsymbol->name() == symbol->name()) {
2433	context_.Say(GetContext().clauseSource,
2434	"%s variable '%s' is %s in outer context must"
2435	" be shared in the parallel regions to which any"
2436	" of the worksharing regions arising from the "
2437	"worksharing construct bind."_err_en_US,
2438	parser::ToUpperCaseLetters(
2439	getClauseName(llvm::omp::Clause::OMPC_reduction)
2440	.str()),
2441	symbol->name(),
2442	parser::ToUpperCaseLetters(
2443	getClauseName(type).str()));
2444	}
2445	}
2446	}
2447	}
2448	}
2449	}
2450	}
2451	}
2452	}
2453	}
2454	}
2455	}
2456
2457	void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
2458	CheckAllowed(llvm::omp::Clause::OMPC_ordered);
2459	// the parameter of ordered clause is optional
2460	if (const auto &expr{x.v}) {
2461	RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
2462	// 2.8.3 Loop SIMD Construct Restriction
2463	if (llvm::omp::allDoSimdSet.test(GetContext().directive)) {
2464	context_.Say(GetContext().clauseSource,
2465	"No ORDERED clause with a parameter can be specified "
2466	"on the %s directive"_err_en_US,
2467	ContextDirectiveAsFortran());
2468	}
2469	}
2470	}
2471
2472	void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
2473	CheckAllowed(llvm::omp::Clause::OMPC_shared);
2474	CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "SHARED");
2475	}
2476	void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
2477	CheckAllowed(llvm::omp::Clause::OMPC_private);
2478	CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "PRIVATE");
2479	CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
2480	}
2481
2482	void OmpStructureChecker::Enter(const parser::OmpClause::Nowait &x) {
2483	CheckAllowed(llvm::omp::Clause::OMPC_nowait);
2484	if (llvm::omp::noWaitClauseNotAllowedSet.test(GetContext().directive)) {
2485	context_.Say(GetContext().clauseSource,
2486	"%s clause is not allowed on the OMP %s directive,"
2487	" use it on OMP END %s directive "_err_en_US,
2488	parser::ToUpperCaseLetters(
2489	getClauseName(llvm::omp::Clause::OMPC_nowait).str()),
2490	parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
2491	parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
2492	}
2493	}
2494
2495	bool OmpStructureChecker::IsDataRefTypeParamInquiry(
2496	const parser::DataRef *dataRef) {
2497	bool dataRefIsTypeParamInquiry{false};
2498	if (const auto *structComp{
2499	parser::Unwrap<parser::StructureComponent>(dataRef)}) {
2500	if (const auto *compSymbol{structComp->component.symbol}) {
2501	if (const auto *compSymbolMiscDetails{
2502	std::get_if<MiscDetails>(&compSymbol->details())}) {
2503	const auto detailsKind = compSymbolMiscDetails->kind();
2504	dataRefIsTypeParamInquiry =
2505	(detailsKind == MiscDetails::Kind::KindParamInquiry ||
2506	detailsKind == MiscDetails::Kind::LenParamInquiry);
2507	} else if (compSymbol->has<TypeParamDetails>()) {
2508	dataRefIsTypeParamInquiry = true;
2509	}
2510	}
2511	}
2512	return dataRefIsTypeParamInquiry;
2513	}
2514
2515	void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
2516	const parser::CharBlock &source, const parser::OmpObjectList &objList,
2517	llvm::StringRef clause) {
2518	for (const auto &ompObject : objList.v) {
2519	common::visit(
2520	common::visitors{
2521	[&](const parser::Designator &designator) {
2522	if (const auto *dataRef{
2523	std::get_if<parser::DataRef>(&designator.u)}) {
2524	if (IsDataRefTypeParamInquiry(dataRef)) {
2525	context_.Say(source,
2526	"A type parameter inquiry cannot appear on the %s "
2527	"directive"_err_en_US,
2528	ContextDirectiveAsFortran());
2529	} else if (parser::Unwrap<parser::StructureComponent>(
2530	ompObject) ||
2531	parser::Unwrap<parser::ArrayElement>(ompObject)) {
2532	if (llvm::omp::nonPartialVarSet.test(
2533	GetContext().directive)) {
2534	context_.Say(source,
2535	"A variable that is part of another variable (as an "
2536	"array or structure element) cannot appear on the %s "
2537	"directive"_err_en_US,
2538	ContextDirectiveAsFortran());
2539	} else {
2540	context_.Say(source,
2541	"A variable that is part of another variable (as an "
2542	"array or structure element) cannot appear in a "
2543	"%s clause"_err_en_US,
2544	clause.data());
2545	}
2546	}
2547	}
2548	},
2549	[&](const parser::Name &name) {},
2550	},
2551	ompObject.u);
2552	}
2553	}
2554
2555	void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
2556	CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
2557
2558	CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "FIRSTPRIVATE");
2559	CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
2560
2561	SymbolSourceMap currSymbols;
2562	GetSymbolsInObjectList(x.v, currSymbols);
2563	CheckCopyingPolymorphicAllocatable(
2564	currSymbols, llvm::omp::Clause::OMPC_firstprivate);
2565
2566	DirectivesClauseTriple dirClauseTriple;
2567	// Check firstprivate variables in worksharing constructs
2568	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
2569	std::make_pair(
2570	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
2571	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
2572	std::make_pair(
2573	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
2574	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
2575	std::make_pair(
2576	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
2577	// Check firstprivate variables in distribute construct
2578	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
2579	std::make_pair(
2580	llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
2581	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
2582	std::make_pair(llvm::omp::Directive::OMPD_target_teams,
2583	llvm::omp::privateReductionSet));
2584	// Check firstprivate variables in task and taskloop constructs
2585	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
2586	std::make_pair(llvm::omp::Directive::OMPD_parallel,
2587	OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
2588	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
2589	std::make_pair(llvm::omp::Directive::OMPD_parallel,
2590	OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
2591
2592	CheckPrivateSymbolsInOuterCxt(
2593	currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
2594	}
2595
2596	void OmpStructureChecker::CheckIsLoopIvPartOfClause(
2597	llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
2598	for (const auto &ompObject : ompObjectList.v) {
2599	if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
2600	if (name->symbol == GetContext().loopIV) {
2601	context_.Say(name->source,
2602	"DO iteration variable %s is not allowed in %s clause."_err_en_US,
2603	name->ToString(),
2604	parser::ToUpperCaseLetters(getClauseName(clause).str()));
2605	}
2606	}
2607	}
2608	}
2609	// Following clauses have a seperate node in parse-tree.h.
2610	// Atomic-clause
2611	CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)
2612	CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
2613	CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
2614	CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
2615
2616	void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {
2617	CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_read,
2618	{llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_acq_rel});
2619	}
2620	void OmpStructureChecker::Leave(const parser::OmpAtomicWrite &) {
2621	CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_write,
2622	{llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
2623	}
2624	void OmpStructureChecker::Leave(const parser::OmpAtomicUpdate &) {
2625	CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_update,
2626	{llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_acq_rel});
2627	}
2628	// OmpAtomic node represents atomic directive without atomic-clause.
2629	// atomic-clause - READ,WRITE,UPDATE,CAPTURE.
2630	void OmpStructureChecker::Leave(const parser::OmpAtomic &) {
2631	if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acquire)}) {
2632	context_.Say(clause->source,
2633	"Clause ACQUIRE is not allowed on the ATOMIC directive"_err_en_US);
2634	}
2635	if (const auto *clause{FindClause(llvm::omp::Clause::OMPC_acq_rel)}) {
2636	context_.Say(clause->source,
2637	"Clause ACQ_REL is not allowed on the ATOMIC directive"_err_en_US);
2638	}
2639	}
2640	// Restrictions specific to each clause are implemented apart from the
2641	// generalized restrictions.
2642	void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
2643	CheckAllowed(llvm::omp::Clause::OMPC_aligned);
2644
2645	if (const auto &expr{
2646	std::get<std::optional<parser::ScalarIntConstantExpr>>(x.v.t)}) {
2647	RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_aligned, *expr);
2648	}
2649	// 2.8.1 TODO: list-item attribute check
2650	}
2651	void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
2652	CheckAllowed(llvm::omp::Clause::OMPC_defaultmap);
2653	using VariableCategory = parser::OmpDefaultmapClause::VariableCategory;
2654	if (!std::get<std::optional<VariableCategory>>(x.v.t)) {
2655	context_.Say(GetContext().clauseSource,
2656	"The argument TOFROM:SCALAR must be specified on the DEFAULTMAP "
2657	"clause"_err_en_US);
2658	}
2659	}
2660	void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
2661	CheckAllowed(llvm::omp::Clause::OMPC_if);
2662	using dirNameModifier = parser::OmpIfClause::DirectiveNameModifier;
2663	// TODO Check that, when multiple 'if' clauses are applied to a combined
2664	// construct, at most one of them applies to each directive.
2665	static std::unordered_map<dirNameModifier, OmpDirectiveSet>
2666	dirNameModifierMap{{dirNameModifier::Parallel, llvm::omp::allParallelSet},
2667	{dirNameModifier::Simd, llvm::omp::allSimdSet},
2668	{dirNameModifier::Target, llvm::omp::allTargetSet},
2669	{dirNameModifier::TargetData,
2670	{llvm::omp::Directive::OMPD_target_data}},
2671	{dirNameModifier::TargetEnterData,
2672	{llvm::omp::Directive::OMPD_target_enter_data}},
2673	{dirNameModifier::TargetExitData,
2674	{llvm::omp::Directive::OMPD_target_exit_data}},
2675	{dirNameModifier::TargetUpdate,
2676	{llvm::omp::Directive::OMPD_target_update}},
2677	{dirNameModifier::Task, {llvm::omp::Directive::OMPD_task}},
2678	{dirNameModifier::Taskloop, llvm::omp::allTaskloopSet},
2679	{dirNameModifier::Teams, llvm::omp::allTeamsSet}};
2680	if (const auto &directiveName{
2681	std::get<std::optional<dirNameModifier>>(x.v.t)}) {
2682	auto search{dirNameModifierMap.find(*directiveName)};
2683	if (search == dirNameModifierMap.end() ||
2684	!search->second.test(GetContext().directive)) {
2685	context_
2686	.Say(GetContext().clauseSource,
2687	"Unmatched directive name modifier %s on the IF clause"_err_en_US,
2688	parser::ToUpperCaseLetters(
2689	parser::OmpIfClause::EnumToString(*directiveName)))
2690	.Attach(
2691	GetContext().directiveSource, "Cannot apply to directive"_en_US);
2692	}
2693	}
2694	}
2695
2696	void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
2697	CheckAllowed(llvm::omp::Clause::OMPC_linear);
2698
2699	// 2.7 Loop Construct Restriction
2700	if ((llvm::omp::allDoSet | llvm::omp::allSimdSet)
2701	.test(GetContext().directive)) {
2702	if (std::holds_alternative<parser::OmpLinearClause::WithModifier>(x.v.u)) {
2703	context_.Say(GetContext().clauseSource,
2704	"A modifier may not be specified in a LINEAR clause "
2705	"on the %s directive"_err_en_US,
2706	ContextDirectiveAsFortran());
2707	}
2708	}
2709	}
2710
2711	void OmpStructureChecker::CheckAllowedMapTypes(
2712	const parser::OmpMapType::Type &type,
2713	const std::list<parser::OmpMapType::Type> &allowedMapTypeList) {
2714	if (!llvm::is_contained(allowedMapTypeList, type)) {
2715	std::string commaSeperatedMapTypes;
2716	llvm::interleave(
2717	allowedMapTypeList.begin(), allowedMapTypeList.end(),
2718	[&](const parser::OmpMapType::Type &mapType) {
2719	commaSeperatedMapTypes.append(parser::ToUpperCaseLetters(
2720	parser::OmpMapType::EnumToString(mapType)));
2721	},
2722	[&] { commaSeperatedMapTypes.append(s: ", "); });
2723	context_.Say(GetContext().clauseSource,
2724	"Only the %s map types are permitted "
2725	"for MAP clauses on the %s directive"_err_en_US,
2726	commaSeperatedMapTypes, ContextDirectiveAsFortran());
2727	}
2728	}
2729
2730	void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
2731	CheckAllowed(llvm::omp::Clause::OMPC_map);
2732
2733	if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.v.t)}) {
2734	using Type = parser::OmpMapType::Type;
2735	const Type &type{std::get<Type>(maptype->t)};
2736	switch (GetContext().directive) {
2737	case llvm::omp::Directive::OMPD_target:
2738	case llvm::omp::Directive::OMPD_target_teams:
2739	case llvm::omp::Directive::OMPD_target_teams_distribute:
2740	case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
2741	case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
2742	case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
2743	case llvm::omp::Directive::OMPD_target_data:
2744	CheckAllowedMapTypes(
2745	type, {Type::To, Type::From, Type::Tofrom, Type::Alloc});
2746	break;
2747	case llvm::omp::Directive::OMPD_target_enter_data:
2748	CheckAllowedMapTypes(type, {Type::To, Type::Alloc});
2749	break;
2750	case llvm::omp::Directive::OMPD_target_exit_data:
2751	CheckAllowedMapTypes(type, {Type::From, Type::Release, Type::Delete});
2752	break;
2753	default:
2754	break;
2755	}
2756	}
2757	}
2758
2759	bool OmpStructureChecker::ScheduleModifierHasType(
2760	const parser::OmpScheduleClause &x,
2761	const parser::OmpScheduleModifierType::ModType &type) {
2762	const auto &modifier{
2763	std::get<std::optional<parser::OmpScheduleModifier>>(x.t)};
2764	if (modifier) {
2765	const auto &modType1{
2766	std::get<parser::OmpScheduleModifier::Modifier1>(modifier->t)};
2767	const auto &modType2{
2768	std::get<std::optional<parser::OmpScheduleModifier::Modifier2>>(
2769	modifier->t)};
2770	if (modType1.v.v == type || (modType2 && modType2->v.v == type)) {
2771	return true;
2772	}
2773	}
2774	return false;
2775	}
2776	void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
2777	CheckAllowed(llvm::omp::Clause::OMPC_schedule);
2778	const parser::OmpScheduleClause &scheduleClause = x.v;
2779
2780	// 2.7 Loop Construct Restriction
2781	if (llvm::omp::allDoSet.test(GetContext().directive)) {
2782	const auto &kind{std::get<1>(scheduleClause.t)};
2783	const auto &chunk{std::get<2>(scheduleClause.t)};
2784	if (chunk) {
2785	if (kind == parser::OmpScheduleClause::ScheduleType::Runtime ||
2786	kind == parser::OmpScheduleClause::ScheduleType::Auto) {
2787	context_.Say(GetContext().clauseSource,
2788	"When SCHEDULE clause has %s specified, "
2789	"it must not have chunk size specified"_err_en_US,
2790	parser::ToUpperCaseLetters(
2791	parser::OmpScheduleClause::EnumToString(kind)));
2792	}
2793	if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
2794	scheduleClause.t)}) {
2795	RequiresPositiveParameter(
2796	llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
2797	}
2798	}
2799
2800	if (ScheduleModifierHasType(scheduleClause,
2801	parser::OmpScheduleModifierType::ModType::Nonmonotonic)) {
2802	if (kind != parser::OmpScheduleClause::ScheduleType::Dynamic &&
2803	kind != parser::OmpScheduleClause::ScheduleType::Guided) {
2804	context_.Say(GetContext().clauseSource,
2805	"The NONMONOTONIC modifier can only be specified with "
2806	"SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
2807	}
2808	}
2809	}
2810	}
2811
2812	void OmpStructureChecker::Enter(const parser::OmpClause::Device &x) {
2813	CheckAllowed(llvm::omp::Clause::OMPC_device);
2814	const parser::OmpDeviceClause &deviceClause = x.v;
2815	const auto &device{std::get<1>(deviceClause.t)};
2816	RequiresPositiveParameter(
2817	llvm::omp::Clause::OMPC_device, device, "device expression");
2818	std::optional<parser::OmpDeviceClause::DeviceModifier> modifier =
2819	std::get<0>(deviceClause.t);
2820	if (modifier &&
2821	*modifier == parser::OmpDeviceClause::DeviceModifier::Ancestor) {
2822	if (GetContext().directive != llvm::omp::OMPD_target) {
2823	context_.Say(GetContext().clauseSource,
2824	"The ANCESTOR device-modifier must not appear on the DEVICE clause on"
2825	" any directive other than the TARGET construct. Found on %s construct."_err_en_US,
2826	parser::ToUpperCaseLetters(getDirectiveName(GetContext().directive)));
2827	}
2828	}
2829	}
2830
2831	void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
2832	CheckAllowed(llvm::omp::Clause::OMPC_depend);
2833	if ((std::holds_alternative<parser::OmpDependClause::Source>(x.v.u) ||
2834	std::holds_alternative<parser::OmpDependClause::Sink>(x.v.u)) &&
2835	GetContext().directive != llvm::omp::OMPD_ordered) {
2836	context_.Say(GetContext().clauseSource,
2837	"DEPEND(SOURCE) or DEPEND(SINK : vec) can be used only with the ordered"
2838	" directive. Used here in the %s construct."_err_en_US,
2839	parser::ToUpperCaseLetters(getDirectiveName(GetContext().directive)));
2840	}
2841	if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) {
2842	const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
2843	for (const auto &ele : designators) {
2844	if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
2845	CheckDependList(*dataRef);
2846	if (const auto *arr{
2847	std::get_if<common::Indirection<parser::ArrayElement>>(
2848	&dataRef->u)}) {
2849	CheckArraySection(arr->value(), GetLastName(*dataRef),
2850	llvm::omp::Clause::OMPC_depend);
2851	}
2852	}
2853	}
2854	}
2855	}
2856
2857	void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
2858	SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
2859	if (context_.ShouldWarn(common::UsageWarning::Portability)) {
2860	for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
2861	const auto *symbol{it->first};
2862	const auto source{it->second};
2863	if (IsPolymorphicAllocatable(*symbol)) {
2864	context_.Say(source,
2865	"If a polymorphic variable with allocatable attribute '%s' is in "
2866	"%s clause, the behavior is unspecified"_port_en_US,
2867	symbol->name(),
2868	parser::ToUpperCaseLetters(getClauseName(clause).str()));
2869	}
2870	}
2871	}
2872	}
2873
2874	void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
2875	CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
2876	CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_copyprivate);
2877	SymbolSourceMap currSymbols;
2878	GetSymbolsInObjectList(x.v, currSymbols);
2879	CheckCopyingPolymorphicAllocatable(
2880	currSymbols, llvm::omp::Clause::OMPC_copyprivate);
2881	if (GetContext().directive == llvm::omp::Directive::OMPD_single) {
2882	context_.Say(GetContext().clauseSource,
2883	"%s clause is not allowed on the OMP %s directive,"
2884	" use it on OMP END %s directive "_err_en_US,
2885	parser::ToUpperCaseLetters(
2886	getClauseName(llvm::omp::Clause::OMPC_copyprivate).str()),
2887	parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()),
2888	parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
2889	}
2890	}
2891
2892	void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
2893	CheckAllowed(llvm::omp::Clause::OMPC_lastprivate);
2894
2895	CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v, "LASTPRIVATE");
2896
2897	DirectivesClauseTriple dirClauseTriple;
2898	SymbolSourceMap currSymbols;
2899	GetSymbolsInObjectList(x.v, currSymbols);
2900	CheckDefinableObjects(currSymbols, GetClauseKindForParserClass(x));
2901	CheckCopyingPolymorphicAllocatable(
2902	currSymbols, llvm::omp::Clause::OMPC_lastprivate);
2903
2904	// Check lastprivate variables in worksharing constructs
2905	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
2906	std::make_pair(
2907	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
2908	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
2909	std::make_pair(
2910	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
2911
2912	CheckPrivateSymbolsInOuterCxt(
2913	currSymbols, dirClauseTriple, GetClauseKindForParserClass(x));
2914	}
2915
2916	void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
2917	CheckAllowed(llvm::omp::Clause::OMPC_copyin);
2918
2919	SymbolSourceMap currSymbols;
2920	GetSymbolsInObjectList(x.v, currSymbols);
2921	CheckCopyingPolymorphicAllocatable(
2922	currSymbols, llvm::omp::Clause::OMPC_copyin);
2923	}
2924
2925	void OmpStructureChecker::CheckStructureElement(
2926	const parser::OmpObjectList &ompObjectList,
2927	const llvm::omp::Clause clause) {
2928	for (const auto &ompObject : ompObjectList.v) {
2929	common::visit(
2930	common::visitors{
2931	[&](const parser::Designator &designator) {
2932	if (std::get_if<parser::DataRef>(&designator.u)) {
2933	if (parser::Unwrap<parser::StructureComponent>(ompObject)) {
2934	context_.Say(GetContext().clauseSource,
2935	"A variable that is part of another variable "
2936	"(structure element) cannot appear on the %s "
2937	"%s clause"_err_en_US,
2938	ContextDirectiveAsFortran(),
2939	parser::ToUpperCaseLetters(getClauseName(clause).str()));
2940	}
2941	}
2942	},
2943	[&](const parser::Name &name) {},
2944	},
2945	ompObject.u);
2946	}
2947	return;
2948	}
2949
2950	void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
2951	CheckStructureElement(x.v, llvm::omp::Clause::OMPC_use_device_ptr);
2952	CheckAllowed(llvm::omp::Clause::OMPC_use_device_ptr);
2953	SymbolSourceMap currSymbols;
2954	GetSymbolsInObjectList(x.v, currSymbols);
2955	semantics::UnorderedSymbolSet listVars;
2956	auto useDevicePtrClauses{FindClauses(llvm::omp::Clause::OMPC_use_device_ptr)};
2957	for (auto itr = useDevicePtrClauses.first; itr != useDevicePtrClauses.second;
2958	++itr) {
2959	const auto &useDevicePtrClause{
2960	std::get<parser::OmpClause::UseDevicePtr>(itr->second->u)};
2961	const auto &useDevicePtrList{useDevicePtrClause.v};
2962	std::list<parser::Name> useDevicePtrNameList;
2963	for (const auto &ompObject : useDevicePtrList.v) {
2964	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2965	if (name->symbol) {
2966	if (!(IsBuiltinCPtr(*(name->symbol)))) {
2967	context_.Say(itr->second->source,
2968	"Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
2969	name->ToString());
2970	} else {
2971	useDevicePtrNameList.push_back(*name);
2972	}
2973	}
2974	}
2975	}
2976	CheckMultipleOccurrence(
2977	listVars, useDevicePtrNameList, itr->second->source, "USE_DEVICE_PTR");
2978	}
2979	}
2980
2981	void OmpStructureChecker::Enter(const parser::OmpClause::UseDeviceAddr &x) {
2982	CheckStructureElement(x.v, llvm::omp::Clause::OMPC_use_device_addr);
2983	CheckAllowed(llvm::omp::Clause::OMPC_use_device_addr);
2984	SymbolSourceMap currSymbols;
2985	GetSymbolsInObjectList(x.v, currSymbols);
2986	semantics::UnorderedSymbolSet listVars;
2987	auto useDeviceAddrClauses{
2988	FindClauses(llvm::omp::Clause::OMPC_use_device_addr)};
2989	for (auto itr = useDeviceAddrClauses.first;
2990	itr != useDeviceAddrClauses.second; ++itr) {
2991	const auto &useDeviceAddrClause{
2992	std::get<parser::OmpClause::UseDeviceAddr>(itr->second->u)};
2993	const auto &useDeviceAddrList{useDeviceAddrClause.v};
2994	std::list<parser::Name> useDeviceAddrNameList;
2995	for (const auto &ompObject : useDeviceAddrList.v) {
2996	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
2997	if (name->symbol) {
2998	useDeviceAddrNameList.push_back(*name);
2999	}
3000	}
3001	}
3002	CheckMultipleOccurrence(listVars, useDeviceAddrNameList,
3003	itr->second->source, "USE_DEVICE_ADDR");
3004	}
3005	}
3006
3007	void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
3008	CheckAllowed(llvm::omp::Clause::OMPC_is_device_ptr);
3009	SymbolSourceMap currSymbols;
3010	GetSymbolsInObjectList(x.v, currSymbols);
3011	semantics::UnorderedSymbolSet listVars;
3012	auto isDevicePtrClauses{FindClauses(llvm::omp::Clause::OMPC_is_device_ptr)};
3013	for (auto itr = isDevicePtrClauses.first; itr != isDevicePtrClauses.second;
3014	++itr) {
3015	const auto &isDevicePtrClause{
3016	std::get<parser::OmpClause::IsDevicePtr>(itr->second->u)};
3017	const auto &isDevicePtrList{isDevicePtrClause.v};
3018	SymbolSourceMap currSymbols;
3019	GetSymbolsInObjectList(isDevicePtrList, currSymbols);
3020	for (auto &[symbol, source] : currSymbols) {
3021	if (!(IsBuiltinCPtr(*symbol))) {
3022	context_.Say(itr->second->source,
3023	"Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
3024	source.ToString());
3025	} else if (!(IsDummy(*symbol))) {
3026	context_.Say(itr->second->source,
3027	"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
3028	"This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
3029	source.ToString());
3030	} else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
3031	context_.Say(itr->second->source,
3032	"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
3033	"that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
3034	"This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
3035	source.ToString());
3036	}
3037	}
3038	}
3039	}
3040
3041	void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) {
3042	CheckAllowed(llvm::omp::Clause::OMPC_has_device_addr);
3043	SymbolSourceMap currSymbols;
3044	GetSymbolsInObjectList(x.v, currSymbols);
3045	semantics::UnorderedSymbolSet listVars;
3046	auto hasDeviceAddrClauses{
3047	FindClauses(llvm::omp::Clause::OMPC_has_device_addr)};
3048	for (auto itr = hasDeviceAddrClauses.first;
3049	itr != hasDeviceAddrClauses.second; ++itr) {
3050	const auto &hasDeviceAddrClause{
3051	std::get<parser::OmpClause::HasDeviceAddr>(itr->second->u)};
3052	const auto &hasDeviceAddrList{hasDeviceAddrClause.v};
3053	std::list<parser::Name> hasDeviceAddrNameList;
3054	for (const auto &ompObject : hasDeviceAddrList.v) {
3055	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3056	if (name->symbol) {
3057	hasDeviceAddrNameList.push_back(*name);
3058	}
3059	}
3060	}
3061	}
3062	}
3063
3064	llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
3065	return llvm::omp::getOpenMPClauseName(clause);
3066	}
3067
3068	llvm::StringRef OmpStructureChecker::getDirectiveName(
3069	llvm::omp::Directive directive) {
3070	return llvm::omp::getOpenMPDirectiveName(directive);
3071	}
3072
3073	void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
3074	common::visit(
3075	common::visitors{
3076	[&](const common::Indirection<parser::ArrayElement> &elem) {
3077	// Check if the base element is valid on Depend Clause
3078	CheckDependList(elem.value().base);
3079	},
3080	[&](const common::Indirection<parser::StructureComponent> &) {
3081	context_.Say(GetContext().clauseSource,
3082	"A variable that is part of another variable "
3083	"(such as an element of a structure) but is not an array "
3084	"element or an array section cannot appear in a DEPEND "
3085	"clause"_err_en_US);
3086	},
3087	[&](const common::Indirection<parser::CoindexedNamedObject> &) {
3088	context_.Say(GetContext().clauseSource,
3089	"Coarrays are not supported in DEPEND clause"_err_en_US);
3090	},
3091	[&](const parser::Name &) { return; },
3092	},
3093	d.u);
3094	}
3095
3096	// Called from both Reduction and Depend clause.
3097	void OmpStructureChecker::CheckArraySection(
3098	const parser::ArrayElement &arrayElement, const parser::Name &name,
3099	const llvm::omp::Clause clause) {
3100	if (!arrayElement.subscripts.empty()) {
3101	for (const auto &subscript : arrayElement.subscripts) {
3102	if (const auto *triplet{
3103	std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
3104	if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
3105	const auto &lower{std::get<0>(triplet->t)};
3106	const auto &upper{std::get<1>(triplet->t)};
3107	if (lower && upper) {
3108	const auto lval{GetIntValue(lower)};
3109	const auto uval{GetIntValue(upper)};
3110	if (lval && uval && *uval < *lval) {
3111	context_.Say(GetContext().clauseSource,
3112	"'%s' in %s clause"
3113	" is a zero size array section"_err_en_US,
3114	name.ToString(),
3115	parser::ToUpperCaseLetters(getClauseName(clause).str()));
3116	break;
3117	} else if (std::get<2>(triplet->t)) {
3118	const auto &strideExpr{std::get<2>(triplet->t)};
3119	if (strideExpr) {
3120	if (clause == llvm::omp::Clause::OMPC_depend) {
3121	context_.Say(GetContext().clauseSource,
3122	"Stride should not be specified for array section in "
3123	"DEPEND "
3124	"clause"_err_en_US);
3125	}
3126	const auto stride{GetIntValue(strideExpr)};
3127	if ((stride && stride != 1)) {
3128	context_.Say(GetContext().clauseSource,
3129	"A list item that appears in a REDUCTION clause"
3130	" should have a contiguous storage array "
3131	"section."_err_en_US,
3132	ContextDirectiveAsFortran());
3133	break;
3134	}
3135	}
3136	}
3137	}
3138	}
3139	}
3140	}
3141	}
3142	}
3143
3144	void OmpStructureChecker::CheckIntentInPointer(
3145	const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
3146	SymbolSourceMap symbols;
3147	GetSymbolsInObjectList(objectList, symbols);
3148	for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
3149	const auto *symbol{it->first};
3150	const auto source{it->second};
3151	if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
3152	context_.Say(source,
3153	"Pointer '%s' with the INTENT(IN) attribute may not appear "
3154	"in a %s clause"_err_en_US,
3155	symbol->name(),
3156	parser::ToUpperCaseLetters(getClauseName(clause).str()));
3157	}
3158	}
3159	}
3160
3161	void OmpStructureChecker::GetSymbolsInObjectList(
3162	const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
3163	for (const auto &ompObject : objectList.v) {
3164	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3165	if (const auto *symbol{name->symbol}) {
3166	if (const auto *commonBlockDetails{
3167	symbol->detailsIf<CommonBlockDetails>()}) {
3168	for (const auto &object : commonBlockDetails->objects()) {
3169	symbols.emplace(&object->GetUltimate(), name->source);
3170	}
3171	} else {
3172	symbols.emplace(&symbol->GetUltimate(), name->source);
3173	}
3174	}
3175	}
3176	}
3177	}
3178
3179	void OmpStructureChecker::CheckDefinableObjects(
3180	SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
3181	for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
3182	const auto *symbol{it->first};
3183	const auto source{it->second};
3184	if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
3185	DefinabilityFlags{}, *symbol)}) {
3186	context_
3187	.Say(source,
3188	"Variable '%s' on the %s clause is not definable"_err_en_US,
3189	symbol->name(),
3190	parser::ToUpperCaseLetters(getClauseName(clause).str()))
3191	.Attach(std::move(*msg));
3192	}
3193	}
3194	}
3195
3196	void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
3197	SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
3198	const llvm::omp::Clause currClause) {
3199	SymbolSourceMap enclosingSymbols;
3200	auto range{dirClauseTriple.equal_range(GetContext().directive)};
3201	for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
3202	auto enclosingDir{dirIter->second.first};
3203	auto enclosingClauseSet{dirIter->second.second};
3204	if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
3205	for (auto it{enclosingContext->clauseInfo.begin()};
3206	it != enclosingContext->clauseInfo.end(); ++it) {
3207	if (enclosingClauseSet.test(it->first)) {
3208	if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
3209	GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
3210	}
3211	}
3212	}
3213
3214	// Check if the symbols in current context are private in outer context
3215	for (auto iter{currSymbols.begin()}; iter != currSymbols.end(); ++iter) {
3216	const auto *symbol{iter->first};
3217	const auto source{iter->second};
3218	if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
3219	context_.Say(source,
3220	"%s variable '%s' is PRIVATE in outer context"_err_en_US,
3221	parser::ToUpperCaseLetters(getClauseName(currClause).str()),
3222	symbol->name());
3223	}
3224	}
3225	}
3226	}
3227	}
3228
3229	bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
3230	const parser::Block &block) {
3231	bool nestedTeams{false};
3232
3233	if (!block.empty()) {
3234	auto it{block.begin()};
3235	if (const auto *ompConstruct{
3236	parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
3237	if (const auto *ompBlockConstruct{
3238	std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
3239	const auto &beginBlockDir{
3240	std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
3241	const auto &beginDir{
3242	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
3243	if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
3244	nestedTeams = true;
3245	}
3246	}
3247	}
3248
3249	if (nestedTeams && ++it == block.end()) {
3250	return true;
3251	}
3252	}
3253
3254	return false;
3255	}
3256
3257	void OmpStructureChecker::CheckWorkshareBlockStmts(
3258	const parser::Block &block, parser::CharBlock source) {
3259	OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
3260
3261	for (auto it{block.begin()}; it != block.end(); ++it) {
3262	if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
3263	parser::Unwrap<parser::ForallStmt>(*it) ||
3264	parser::Unwrap<parser::ForallConstruct>(*it) ||
3265	parser::Unwrap<parser::WhereStmt>(*it) ||
3266	parser::Unwrap<parser::WhereConstruct>(*it)) {
3267	parser::Walk(*it, ompWorkshareBlockChecker);
3268	} else if (const auto *ompConstruct{
3269	parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
3270	if (const auto *ompAtomicConstruct{
3271	std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
3272	// Check if assignment statements in the enclosing OpenMP Atomic
3273	// construct are allowed in the Workshare construct
3274	parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
3275	} else if (const auto *ompCriticalConstruct{
3276	std::get_if<parser::OpenMPCriticalConstruct>(
3277	&ompConstruct->u)}) {
3278	// All the restrictions on the Workshare construct apply to the
3279	// statements in the enclosing critical constructs
3280	const auto &criticalBlock{
3281	std::get<parser::Block>(ompCriticalConstruct->t)};
3282	CheckWorkshareBlockStmts(criticalBlock, source);
3283	} else {
3284	// Check if OpenMP constructs enclosed in the Workshare construct are
3285	// 'Parallel' constructs
3286	auto currentDir{llvm::omp::Directive::OMPD_unknown};
3287	if (const auto *ompBlockConstruct{
3288	std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
3289	const auto &beginBlockDir{
3290	std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
3291	const auto &beginDir{
3292	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
3293	currentDir = beginDir.v;
3294	} else if (const auto *ompLoopConstruct{
3295	std::get_if<parser::OpenMPLoopConstruct>(
3296	&ompConstruct->u)}) {
3297	const auto &beginLoopDir{
3298	std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
3299	const auto &beginDir{
3300	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
3301	currentDir = beginDir.v;
3302	} else if (const auto *ompSectionsConstruct{
3303	std::get_if<parser::OpenMPSectionsConstruct>(
3304	&ompConstruct->u)}) {
3305	const auto &beginSectionsDir{
3306	std::get<parser::OmpBeginSectionsDirective>(
3307	ompSectionsConstruct->t)};
3308	const auto &beginDir{
3309	std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
3310	currentDir = beginDir.v;
3311	}
3312
3313	if (!llvm::omp::topParallelSet.test(currentDir)) {
3314	context_.Say(source,
3315	"OpenMP constructs enclosed in WORKSHARE construct may consist "
3316	"of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
3317	}
3318	}
3319	} else {
3320	context_.Say(source,
3321	"The structured block in a WORKSHARE construct may consist of only "
3322	"SCALAR or ARRAY assignments, FORALL or WHERE statements, "
3323	"FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
3324	}
3325	}
3326	}
3327
3328	const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
3329	const parser::OmpClause &clause) {
3330
3331	// Clauses with OmpObjectList as its data member
3332	using MemberObjectListClauses =
3333	std::tuple<parser::OmpClause::Copyprivate, parser::OmpClause::Copyin,
3334	parser::OmpClause::Firstprivate, parser::OmpClause::From,
3335	parser::OmpClause::Lastprivate, parser::OmpClause::Link,
3336	parser::OmpClause::Private, parser::OmpClause::Shared,
3337	parser::OmpClause::To, parser::OmpClause::Enter,
3338	parser::OmpClause::UseDevicePtr, parser::OmpClause::UseDeviceAddr>;
3339
3340	// Clauses with OmpObjectList in the tuple
3341	using TupleObjectListClauses =
3342	std::tuple<parser::OmpClause::Allocate, parser::OmpClause::Map,
3343	parser::OmpClause::Reduction, parser::OmpClause::Aligned>;
3344
3345	// TODO:: Generate the tuples using TableGen.
3346	// Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
3347	return common::visit(
3348	common::visitors{
3349	[&](const auto &x) -> const parser::OmpObjectList * {
3350	using Ty = std::decay_t<decltype(x)>;
3351	if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
3352	return &x.v;
3353	} else if constexpr (common::HasMember<Ty,
3354	TupleObjectListClauses>) {
3355	return &(std::get<parser::OmpObjectList>(x.v.t));
3356	} else {
3357	return nullptr;
3358	}
3359	},
3360	},
3361	clause.u);
3362	}
3363
3364	void OmpStructureChecker::Enter(
3365	const parser::OmpClause::AtomicDefaultMemOrder &x) {
3366	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_atomic_default_mem_order);
3367	}
3368
3369	void OmpStructureChecker::Enter(const parser::OmpClause::DynamicAllocators &x) {
3370	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_dynamic_allocators);
3371	}
3372
3373	void OmpStructureChecker::Enter(const parser::OmpClause::ReverseOffload &x) {
3374	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_reverse_offload);
3375	}
3376
3377	void OmpStructureChecker::Enter(const parser::OmpClause::UnifiedAddress &x) {
3378	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_address);
3379	}
3380
3381	void OmpStructureChecker::Enter(
3382	const parser::OmpClause::UnifiedSharedMemory &x) {
3383	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_shared_memory);
3384	}
3385
3386	void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
3387	CheckAllowed(clause);
3388
3389	if (clause != llvm::omp::Clause::OMPC_atomic_default_mem_order) {
3390	// Check that it does not appear after a device construct
3391	if (deviceConstructFound_) {
3392	context_.Say(GetContext().clauseSource,
3393	"REQUIRES directive with '%s' clause found lexically after device "
3394	"construct"_err_en_US,
3395	parser::ToUpperCaseLetters(getClauseName(clause).str()));
3396	}
3397	}
3398	}
3399
3400	} // namespace Fortran::semantics
3401