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 "resolve-names-utils.h"
12	#include "flang/Evaluate/check-expression.h"
13	#include "flang/Evaluate/expression.h"
14	#include "flang/Evaluate/type.h"
15	#include "flang/Parser/parse-tree.h"
16	#include "flang/Semantics/expression.h"
17	#include "flang/Semantics/openmp-modifiers.h"
18	#include "flang/Semantics/tools.h"
19	#include "llvm/ADT/STLExtras.h"
20	#include "llvm/ADT/StringSwitch.h"
21	#include <variant>
22
23	namespace Fortran::semantics {
24
25	template <typename T, typename U>
26	static bool operator!=(const evaluate::Expr<T> &e, const evaluate::Expr<U> &f) {
27	return !(e == f);
28	}
29
30	// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
31	#define CHECK_SIMPLE_CLAUSE(X, Y) \
32	void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
33	CheckAllowedClause(llvm::omp::Clause::Y); \
34	}
35
36	#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
37	void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
38	CheckAllowedClause(llvm::omp::Clause::Y); \
39	RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
40	}
41
42	#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
43	void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
44	CheckAllowedClause(llvm::omp::Clause::Y); \
45	RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
46	}
47
48	// Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
49	#define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
50	void OmpStructureChecker::Enter(const parser::X &) { \
51	CheckAllowedClause(llvm::omp::Y); \
52	}
53
54	std::string ThisVersion(unsigned version) {
55	std::string tv{
56	std::to_string(val: version / 10) + "." + std::to_string(val: version % 10)};
57	return "OpenMP v" + tv;
58	}
59
60	std::string TryVersion(unsigned version) {
61	return "try -fopenmp-version=" + std::to_string(val: version);
62	}
63
64	static const parser::Designator *GetDesignatorFromObj(
65	const parser::OmpObject &object) {
66	return std::get_if<parser::Designator>(&object.u);
67	}
68
69	static const parser::DataRef *GetDataRefFromObj(
70	const parser::OmpObject &object) {
71	if (auto *desg{GetDesignatorFromObj(object)}) {
72	return std::get_if<parser::DataRef>(&desg->u);
73	}
74	return nullptr;
75	}
76
77	static const parser::ArrayElement *GetArrayElementFromObj(
78	const parser::OmpObject &object) {
79	if (auto *dataRef{GetDataRefFromObj(object)}) {
80	using ElementIndirection = common::Indirection<parser::ArrayElement>;
81	if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) {
82	return &ind->value();
83	}
84	}
85	return nullptr;
86	}
87
88	static bool IsVarOrFunctionRef(const MaybeExpr &expr) {
89	if (expr) {
90	return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
91	evaluate::IsVariable(*expr);
92	} else {
93	return false;
94	}
95	}
96
97	static std::optional<SomeExpr> GetEvaluateExpr(const parser::Expr &parserExpr) {
98	const parser::TypedExpr &typedExpr{parserExpr.typedExpr};
99	// ForwardOwningPointer typedExpr
100	// `- GenericExprWrapper ^.get()
101	// `- std::optional<Expr> ^->v
102	return typedExpr.get()->v;
103	}
104
105	static std::optional<evaluate::DynamicType> GetDynamicType(
106	const parser::Expr &parserExpr) {
107	if (auto maybeExpr{GetEvaluateExpr(parserExpr)}) {
108	return maybeExpr->GetType();
109	} else {
110	return std::nullopt;
111	}
112	}
113
114	// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
115	// statements and the expressions enclosed in an OpenMP Workshare construct
116	class OmpWorkshareBlockChecker {
117	public:
118	OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
119	: context_{context}, source_{source} {}
120
121	template <typename T> bool Pre(const T &) { return true; }
122	template <typename T> void Post(const T &) {}
123
124	bool Pre(const parser::AssignmentStmt &assignment) {
125	const auto &var{std::get<parser::Variable>(assignment.t)};
126	const auto &expr{std::get<parser::Expr>(assignment.t)};
127	const auto *lhs{GetExpr(context_, var)};
128	const auto *rhs{GetExpr(context_, expr)};
129	if (lhs && rhs) {
130	Tristate isDefined{semantics::IsDefinedAssignment(
131	lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
132	if (isDefined == Tristate::Yes) {
133	context_.Say(expr.source,
134	"Defined assignment statement is not "
135	"allowed in a WORKSHARE construct"_err_en_US);
136	}
137	}
138	return true;
139	}
140
141	bool Pre(const parser::Expr &expr) {
142	if (const auto *e{GetExpr(context_, expr)}) {
143	for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
144	const Symbol &root{GetAssociationRoot(symbol)};
145	if (IsFunction(root)) {
146	std::string attrs{""};
147	if (!IsElementalProcedure(root)) {
148	attrs = " non-ELEMENTAL";
149	}
150	if (root.attrs().test(Attr::IMPURE)) {
151	if (attrs != "") {
152	attrs = "," + attrs;
153	}
154	attrs = " IMPURE" + attrs;
155	}
156	if (attrs != "") {
157	context_.Say(expr.source,
158	"User defined%s function '%s' is not allowed in a "
159	"WORKSHARE construct"_err_en_US,
160	attrs, root.name());
161	}
162	}
163	}
164	}
165	return false;
166	}
167
168	private:
169	SemanticsContext &context_;
170	parser::CharBlock source_;
171	};
172
173	class AssociatedLoopChecker {
174	public:
175	AssociatedLoopChecker(SemanticsContext &context, std::int64_t level)
176	: context_{context}, level_{level} {}
177
178	template <typename T> bool Pre(const T &) { return true; }
179	template <typename T> void Post(const T &) {}
180
181	bool Pre(const parser::DoConstruct &dc) {
182	level_--;
183	const auto &doStmt{
184	std::get<parser::Statement<parser::NonLabelDoStmt>>(dc.t)};
185	const auto &constructName{
186	std::get<std::optional<parser::Name>>(doStmt.statement.t)};
187	if (constructName) {
188	constructNamesAndLevels_.emplace(
189	constructName.value().ToString(), level_);
190	}
191	if (level_ >= 0) {
192	if (dc.IsDoWhile()) {
193	context_.Say(doStmt.source,
194	"The associated loop of a loop-associated directive cannot be a DO WHILE."_err_en_US);
195	}
196	if (!dc.GetLoopControl()) {
197	context_.Say(doStmt.source,
198	"The associated loop of a loop-associated directive cannot be a DO without control."_err_en_US);
199	}
200	}
201	return true;
202	}
203
204	void Post(const parser::DoConstruct &dc) { level_++; }
205
206	bool Pre(const parser::CycleStmt &cyclestmt) {
207	std::map<std::string, std::int64_t>::iterator it;
208	bool err{false};
209	if (cyclestmt.v) {
210	it = constructNamesAndLevels_.find(cyclestmt.v->source.ToString());
211	err = (it != constructNamesAndLevels_.end() && it->second > 0);
212	} else { // If there is no label then use the level of the last enclosing DO
213	err = level_ > 0;
214	}
215	if (err) {
216	context_.Say(*source_,
217	"CYCLE statement to non-innermost associated loop of an OpenMP DO "
218	"construct"_err_en_US);
219	}
220	return true;
221	}
222
223	bool Pre(const parser::ExitStmt &exitStmt) {
224	std::map<std::string, std::int64_t>::iterator it;
225	bool err{false};
226	if (exitStmt.v) {
227	it = constructNamesAndLevels_.find(exitStmt.v->source.ToString());
228	err = (it != constructNamesAndLevels_.end() && it->second >= 0);
229	} else { // If there is no label then use the level of the last enclosing DO
230	err = level_ >= 0;
231	}
232	if (err) {
233	context_.Say(*source_,
234	"EXIT statement terminates associated loop of an OpenMP DO "
235	"construct"_err_en_US);
236	}
237	return true;
238	}
239
240	bool Pre(const parser::Statement<parser::ActionStmt> &actionstmt) {
241	source_ = &actionstmt.source;
242	return true;
243	}
244
245	private:
246	SemanticsContext &context_;
247	const parser::CharBlock *source_;
248	std::int64_t level_;
249	std::map<std::string, std::int64_t> constructNamesAndLevels_;
250	};
251
252	// `OmpUnitedTaskDesignatorChecker` is used to check if the designator
253	// can appear within the TASK construct
254	class OmpUnitedTaskDesignatorChecker {
255	public:
256	OmpUnitedTaskDesignatorChecker(SemanticsContext &context)
257	: context_{context} {}
258
259	template <typename T> bool Pre(const T &) { return true; }
260	template <typename T> void Post(const T &) {}
261
262	bool Pre(const parser::Name &name) {
263	if (name.symbol->test(Symbol::Flag::OmpThreadprivate)) {
264	// OpenMP 5.2: 5.2 threadprivate directive restriction
265	context_.Say(name.source,
266	"A THREADPRIVATE variable `%s` cannot appear in an UNTIED TASK region"_err_en_US,
267	name.source);
268	}
269	return true;
270	}
271
272	private:
273	SemanticsContext &context_;
274	};
275
276	bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
277	// Do not do clause checks while processing METADIRECTIVE.
278	// Context selectors can contain clauses that are not given as a part
279	// of a construct, but as trait properties. Testing whether they are
280	// valid or not is deferred to the checks of the context selectors.
281	// As it stands now, these clauses would appear as if they were present
282	// on METADIRECTIVE, leading to incorrect diagnostics.
283	if (GetDirectiveNest(index: ContextSelectorNest) > 0) {
284	return true;
285	}
286
287	unsigned version{context_.langOptions().OpenMPVersion};
288	DirectiveContext &dirCtx = GetContext();
289	llvm::omp::Directive dir{dirCtx.directive};
290
291	if (!llvm::omp::isAllowedClauseForDirective(dir, clause, version)) {
292	unsigned allowedInVersion{[&] {
293	for (unsigned v : llvm::omp::getOpenMPVersions()) {
294	if (v <= version) {
295	continue;
296	}
297	if (llvm::omp::isAllowedClauseForDirective(dir, clause, v)) {
298	return v;
299	}
300	}
301	return 0u;
302	}()};
303
304	// Only report it if there is a later version that allows it.
305	// If it's not allowed at all, it will be reported by CheckAllowed.
306	if (allowedInVersion != 0) {
307	auto clauseName{parser::ToUpperCaseLetters(getClauseName(clause).str())};
308	auto dirName{parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
309
310	context_.Say(dirCtx.clauseSource,
311	"%s clause is not allowed on directive %s in %s, %s"_err_en_US,
312	clauseName, dirName, ThisVersion(version),
313	TryVersion(allowedInVersion));
314	}
315	}
316	return CheckAllowed(clause);
317	}
318
319	bool OmpStructureChecker::IsCommonBlock(const Symbol &sym) {
320	return sym.detailsIf<CommonBlockDetails>() != nullptr;
321	}
322
323	bool OmpStructureChecker::IsVariableListItem(const Symbol &sym) {
324	return evaluate::IsVariable(sym) || sym.attrs().test(Attr::POINTER);
325	}
326
327	bool OmpStructureChecker::IsExtendedListItem(const Symbol &sym) {
328	return IsVariableListItem(sym) || sym.IsSubprogram();
329	}
330
331	bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
332	// Definition of close nesting:
333	//
334	// `A region nested inside another region with no parallel region nested
335	// between them`
336	//
337	// Examples:
338	// non-parallel construct 1
339	// non-parallel construct 2
340	// parallel construct
341	// construct 3
342	// In the above example, construct 3 is NOT closely nested inside construct 1
343	// or 2
344	//
345	// non-parallel construct 1
346	// non-parallel construct 2
347	// construct 3
348	// In the above example, construct 3 is closely nested inside BOTH construct 1
349	// and 2
350	//
351	// Algorithm:
352	// Starting from the parent context, Check in a bottom-up fashion, each level
353	// of the context stack. If we have a match for one of the (supplied)
354	// violating directives, `close nesting` is satisfied. If no match is there in
355	// the entire stack, `close nesting` is not satisfied. If at any level, a
356	// `parallel` region is found, `close nesting` is not satisfied.
357
358	if (CurrentDirectiveIsNested()) {
359	int index = dirContext_.size() - 2;
360	while (index != -1) {
361	if (set.test(dirContext_[index].directive)) {
362	return true;
363	} else if (llvm::omp::allParallelSet.test(dirContext_[index].directive)) {
364	return false;
365	}
366	index--;
367	}
368	}
369	return false;
370	}
371
372	namespace {
373	struct ContiguousHelper {
374	ContiguousHelper(SemanticsContext &context)
375	: fctx_(context.foldingContext()) {}
376
377	template <typename Contained>
378	std::optional<bool> Visit(const common::Indirection<Contained> &x) {
379	return Visit(x.value());
380	}
381	template <typename Contained>
382	std::optional<bool> Visit(const common::Reference<Contained> &x) {
383	return Visit(x.get());
384	}
385	template <typename T> std::optional<bool> Visit(const evaluate::Expr<T> &x) {
386	return common::visit([&](auto &&s) { return Visit(s); }, x.u);
387	}
388	template <typename T>
389	std::optional<bool> Visit(const evaluate::Designator<T> &x) {
390	return common::visit(
391	[this](auto &&s) { return evaluate::IsContiguous(s, fctx_); }, x.u);
392	}
393	template <typename T> std::optional<bool> Visit(const T &) {
394	// Everything else.
395	return std::nullopt;
396	}
397
398	private:
399	evaluate::FoldingContext &fctx_;
400	};
401	} // namespace
402
403	// Return values:
404	// - std::optional<bool>{true} if the object is known to be contiguous
405	// - std::optional<bool>{false} if the object is known not to be contiguous
406	// - std::nullopt if the object contiguity cannot be determined
407	std::optional<bool> OmpStructureChecker::IsContiguous(
408	const parser::OmpObject &object) {
409	return common::visit( //
410	common::visitors{
411	[&](const parser::Name &x) {
412	// Any member of a common block must be contiguous.
413	return std::optional<bool>{true};
414	},
415	[&](const parser::Designator &x) {
416	evaluate::ExpressionAnalyzer ea{context_};
417	if (MaybeExpr maybeExpr{ea.Analyze(x)}) {
418	return ContiguousHelper{context_}.Visit(*maybeExpr);
419	}
420	return std::optional<bool>{};
421	},
422	},
423	object.u);
424	}
425
426	void OmpStructureChecker::CheckVariableListItem(
427	const SymbolSourceMap &symbols) {
428	for (auto &[symbol, source] : symbols) {
429	if (!IsVariableListItem(*symbol)) {
430	context_.SayWithDecl(
431	*symbol, source, "'%s' must be a variable"_err_en_US, symbol->name());
432	}
433	}
434	}
435
436	void OmpStructureChecker::CheckMultipleOccurrence(
437	semantics::UnorderedSymbolSet &listVars,
438	const std::list<parser::Name> &nameList, const parser::CharBlock &item,
439	const std::string &clauseName) {
440	for (auto const &var : nameList) {
441	if (llvm::is_contained(listVars, *(var.symbol))) {
442	context_.Say(item,
443	"List item '%s' present at multiple %s clauses"_err_en_US,
444	var.ToString(), clauseName);
445	}
446	listVars.insert(*(var.symbol));
447	}
448	}
449
450	void OmpStructureChecker::CheckMultListItems() {
451	semantics::UnorderedSymbolSet listVars;
452
453	// Aligned clause
454	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_aligned)) {
455	const auto &alignedClause{std::get<parser::OmpClause::Aligned>(clause->u)};
456	const auto &alignedList{std::get<0>(alignedClause.v.t)};
457	std::list<parser::Name> alignedNameList;
458	for (const auto &ompObject : alignedList.v) {
459	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
460	if (name->symbol) {
461	if (FindCommonBlockContaining(*(name->symbol))) {
462	context_.Say(clause->source,
463	"'%s' is a common block name and can not appear in an "
464	"ALIGNED clause"_err_en_US,
465	name->ToString());
466	} else if (!(IsBuiltinCPtr(*(name->symbol)) ||
467	IsAllocatableOrObjectPointer(
468	&name->symbol->GetUltimate()))) {
469	context_.Say(clause->source,
470	"'%s' in ALIGNED clause must be of type C_PTR, POINTER or "
471	"ALLOCATABLE"_err_en_US,
472	name->ToString());
473	} else {
474	alignedNameList.push_back(*name);
475	}
476	} else {
477	// The symbol is null, return early
478	return;
479	}
480	}
481	}
482	CheckMultipleOccurrence(
483	listVars, alignedNameList, clause->source, "ALIGNED");
484	}
485
486	// Nontemporal clause
487	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_nontemporal)) {
488	const auto &nontempClause{
489	std::get<parser::OmpClause::Nontemporal>(clause->u)};
490	const auto &nontempNameList{nontempClause.v};
491	CheckMultipleOccurrence(
492	listVars, nontempNameList, clause->source, "NONTEMPORAL");
493	}
494
495	// Linear clause
496	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_linear)) {
497	auto &linearClause{std::get<parser::OmpClause::Linear>(clause->u)};
498	std::list<parser::Name> nameList;
499	SymbolSourceMap symbols;
500	GetSymbolsInObjectList(
501	std::get<parser::OmpObjectList>(linearClause.v.t), symbols);
502	llvm::transform(symbols, std::back_inserter(nameList), [&](auto &&pair) {
503	return parser::Name{pair.second, const_cast<Symbol *>(pair.first)};
504	});
505	CheckMultipleOccurrence(listVars, nameList, clause->source, "LINEAR");
506	}
507	}
508
509	bool OmpStructureChecker::HasInvalidWorksharingNesting(
510	const parser::CharBlock &source, const OmpDirectiveSet &set) {
511	// set contains all the invalid closely nested directives
512	// for the given directive (`source` here)
513	if (IsCloselyNestedRegion(set)) {
514	context_.Say(source,
515	"A worksharing region may not be closely nested inside a "
516	"worksharing, explicit task, taskloop, critical, ordered, atomic, or "
517	"master region"_err_en_US);
518	return true;
519	}
520	return false;
521	}
522
523	void OmpStructureChecker::HasInvalidDistributeNesting(
524	const parser::OpenMPLoopConstruct &x) {
525	bool violation{false};
526	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
527	const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
528	if (llvm::omp::topDistributeSet.test(beginDir.v)) {
529	// `distribute` region has to be nested
530	if (!CurrentDirectiveIsNested()) {
531	violation = true;
532	} else {
533	// `distribute` region has to be strictly nested inside `teams`
534	if (!llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
535	violation = true;
536	}
537	}
538	}
539	if (violation) {
540	context_.Say(beginDir.source,
541	"`DISTRIBUTE` region has to be strictly nested inside `TEAMS` "
542	"region."_err_en_US);
543	}
544	}
545	void OmpStructureChecker::HasInvalidLoopBinding(
546	const parser::OpenMPLoopConstruct &x) {
547	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
548	const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
549
550	auto teamsBindingChecker = [&](parser::MessageFixedText msg) {
551	const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
552	for (const auto &clause : clauseList.v) {
553	if (const auto *bindClause{
554	std::get_if<parser::OmpClause::Bind>(&clause.u)}) {
555	if (bindClause->v.v != parser::OmpBindClause::Binding::Teams) {
556	context_.Say(beginDir.source, msg);
557	}
558	}
559	}
560	};
561
562	if (llvm::omp::Directive::OMPD_loop == beginDir.v &&
563	CurrentDirectiveIsNested() &&
564	llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
565	teamsBindingChecker(
566	"`BIND(TEAMS)` must be specified since the `LOOP` region is "
567	"strictly nested inside a `TEAMS` region."_err_en_US);
568	}
569
570	if (OmpDirectiveSet{
571	llvm::omp::OMPD_teams_loop, llvm::omp::OMPD_target_teams_loop}
572	.test(beginDir.v)) {
573	teamsBindingChecker(
574	"`BIND(TEAMS)` must be specified since the `LOOP` directive is "
575	"combined with a `TEAMS` construct."_err_en_US);
576	}
577	}
578
579	void OmpStructureChecker::HasInvalidTeamsNesting(
580	const llvm::omp::Directive &dir, const parser::CharBlock &source) {
581	if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
582	context_.Say(source,
583	"Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be "
584	"strictly nested inside `TEAMS` region."_err_en_US);
585	}
586	}
587
588	void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
589	const parser::CharBlock &source, const parser::Name &name) {
590	if (const auto *symbol{name.symbol}) {
591	const auto *commonBlock{FindCommonBlockContaining(*symbol)};
592	const auto &scope{context_.FindScope(symbol->name())};
593	const Scope &containingScope{GetProgramUnitContaining(scope)};
594	if (!isPredefinedAllocator &&
595	(IsSaved(*symbol) || commonBlock ||
596	containingScope.kind() == Scope::Kind::Module)) {
597	context_.Say(source,
598	"If list items within the %s directive have the "
599	"SAVE attribute, are a common block name, or are "
600	"declared in the scope of a module, then only "
601	"predefined memory allocator parameters can be used "
602	"in the allocator clause"_err_en_US,
603	ContextDirectiveAsFortran());
604	}
605	}
606	}
607
608	void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
609	const parser::CharBlock &source,
610	const parser::OmpObjectList &ompObjectList) {
611	for (const auto &ompObject : ompObjectList.v) {
612	common::visit(
613	common::visitors{
614	[&](const parser::Designator &designator) {
615	if (const auto *dataRef{
616	std::get_if<parser::DataRef>(&designator.u)}) {
617	if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
618	CheckPredefinedAllocatorRestriction(source, *name);
619	}
620	}
621	},
622	[&](const parser::Name &name) {
623	CheckPredefinedAllocatorRestriction(source, name);
624	},
625	},
626	ompObject.u);
627	}
628	}
629
630	void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {
631	CheckAllowedClause(llvm::omp::Clause::OMPC_hint);
632	auto &dirCtx{GetContext()};
633
634	if (std::optional<int64_t> maybeVal{GetIntValue(x.v.v)}) {
635	int64_t val{*maybeVal};
636	if (val >= 0) {
637	// Check contradictory values.
638	if ((val & 0xC) == 0xC || // omp_sync_hint_speculative and nonspeculative
639	(val & 0x3) == 0x3) { // omp_sync_hint_contended and uncontended
640	context_.Say(dirCtx.clauseSource,
641	"The synchronization hint is not valid"_err_en_US);
642	}
643	} else {
644	context_.Say(dirCtx.clauseSource,
645	"Synchronization hint must be non-negative"_err_en_US);
646	}
647	} else {
648	context_.Say(dirCtx.clauseSource,
649	"Synchronization hint must be a constant integer value"_err_en_US);
650	}
651	}
652
653	void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
654	// OmpDirectiveSpecification exists on its own only in METADIRECTIVE.
655	// In other cases it's a part of other constructs that handle directive
656	// context stack by themselves.
657	if (GetDirectiveNest(index: MetadirectiveNest)) {
658	PushContextAndClauseSets(
659	std::get<parser::OmpDirectiveName>(x.t).source, x.DirId());
660	}
661	}
662
663	void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {
664	if (GetDirectiveNest(index: MetadirectiveNest)) {
665	dirContext_.pop_back();
666	}
667	}
668
669	void OmpStructureChecker::Enter(const parser::OmpMetadirectiveDirective &x) {
670	EnterDirectiveNest(index: MetadirectiveNest);
671	PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_metadirective);
672	}
673
674	void OmpStructureChecker::Leave(const parser::OmpMetadirectiveDirective &) {
675	ExitDirectiveNest(index: MetadirectiveNest);
676	dirContext_.pop_back();
677	}
678
679	void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
680	// Simd Construct with Ordered Construct Nesting check
681	// We cannot use CurrentDirectiveIsNested() here because
682	// PushContextAndClauseSets() has not been called yet, it is
683	// called individually for each construct. Therefore a
684	// dirContext_ size `1` means the current construct is nested
685	if (dirContext_.size() >= 1) {
686	if (GetDirectiveNest(index: SIMDNest) > 0) {
687	CheckSIMDNest(x);
688	}
689	if (GetDirectiveNest(index: TargetNest) > 0) {
690	CheckTargetNest(x);
691	}
692	}
693	}
694
695	void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
696	for (const auto &[sym, source] : deferredNonVariables_) {
697	context_.SayWithDecl(
698	*sym, source, "'%s' must be a variable"_err_en_US, sym->name());
699	}
700	deferredNonVariables_.clear();
701	}
702
703	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
704	EnterDirectiveNest(index: DeclarativeNest);
705	}
706
707	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeConstruct &x) {
708	ExitDirectiveNest(index: DeclarativeNest);
709	}
710
711	void OmpStructureChecker::AddEndDirectiveClauses(
712	const parser::OmpClauseList &clauses) {
713	for (const parser::OmpClause &clause : clauses.v) {
714	GetContext().endDirectiveClauses.push_back(clause.Id());
715	}
716	}
717
718	void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
719	loopStack_.push_back(&x);
720	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
721	const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
722
723	PushContextAndClauseSets(beginDir.source, beginDir.v);
724
725	// check matching, End directive is optional
726	if (const auto &endLoopDir{
727	std::get<std::optional<parser::OmpEndLoopDirective>>(x.t)}) {
728	const auto &endDir{
729	std::get<parser::OmpLoopDirective>(endLoopDir.value().t)};
730
731	CheckMatching<parser::OmpLoopDirective>(beginDir, endDir);
732
733	AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endLoopDir->t));
734	}
735
736	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
737	EnterDirectiveNest(index: SIMDNest);
738	}
739
740	// Combined target loop constructs are target device constructs. Keep track of
741	// whether any such construct has been visited to later check that REQUIRES
742	// directives for target-related options don't appear after them.
743	if (llvm::omp::allTargetSet.test(beginDir.v)) {
744	deviceConstructFound_ = true;
745	}
746
747	if (beginDir.v == llvm::omp::Directive::OMPD_do) {
748	// 2.7.1 do-clause -> private-clause |
749	// firstprivate-clause |
750	// lastprivate-clause |
751	// linear-clause |
752	// reduction-clause |
753	// schedule-clause |
754	// collapse-clause |
755	// ordered-clause
756
757	// nesting check
758	HasInvalidWorksharingNesting(
759	beginDir.source, llvm::omp::nestedWorkshareErrSet);
760	}
761	SetLoopInfo(x);
762
763	if (const auto &doConstruct{
764	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
765	const auto &doBlock{std::get<parser::Block>(doConstruct->t)};
766	CheckNoBranching(doBlock, beginDir.v, beginDir.source);
767	}
768	CheckLoopItrVariableIsInt(x);
769	CheckAssociatedLoopConstraints(x);
770	HasInvalidDistributeNesting(x);
771	HasInvalidLoopBinding(x);
772	if (CurrentDirectiveIsNested() &&
773	llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
774	HasInvalidTeamsNesting(beginDir.v, beginDir.source);
775	}
776	if ((beginDir.v == llvm::omp::Directive::OMPD_distribute_parallel_do_simd) ||
777	(beginDir.v == llvm::omp::Directive::OMPD_distribute_simd)) {
778	CheckDistLinear(x);
779	}
780	}
781	const parser::Name OmpStructureChecker::GetLoopIndex(
782	const parser::DoConstruct *x) {
783	using Bounds = parser::LoopControl::Bounds;
784	return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
785	}
786	void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
787	if (const auto &loopConstruct{
788	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
789	const parser::DoConstruct *loop{&*loopConstruct};
790	if (loop && loop->IsDoNormal()) {
791	const parser::Name &itrVal{GetLoopIndex(loop)};
792	SetLoopIv(itrVal.symbol);
793	}
794	}
795	}
796
797	void OmpStructureChecker::CheckIteratorRange(
798	const parser::OmpIteratorSpecifier &x) {
799	// Check:
800	// 1. Whether begin/end are present.
801	// 2. Whether the step value is non-zero.
802	// 3. If the step has a known sign, whether the lower/upper bounds form
803	// a proper interval.
804	const auto &[begin, end, step]{std::get<parser::SubscriptTriplet>(x.t).t};
805	if (!begin || !end) {
806	context_.Say(x.source,
807	"The begin and end expressions in iterator range-specification are "
808	"mandatory"_err_en_US);
809	}
810	// [5.2:67:19] In a range-specification, if the step is not specified its
811	// value is implicitly defined to be 1.
812	if (auto stepv{step ? GetIntValue(*step) : std::optional<int64_t>{1}}) {
813	if (*stepv == 0) {
814	context_.Say(
815	x.source, "The step value in the iterator range is 0"_warn_en_US);
816	} else if (begin && end) {
817	std::optional<int64_t> beginv{GetIntValue(*begin)};
818	std::optional<int64_t> endv{GetIntValue(*end)};
819	if (beginv && endv) {
820	if (*stepv > 0 && *beginv > *endv) {
821	context_.Say(x.source,
822	"The begin value is greater than the end value in iterator "
823	"range-specification with a positive step"_warn_en_US);
824	} else if (*stepv < 0 && *beginv < *endv) {
825	context_.Say(x.source,
826	"The begin value is less than the end value in iterator "
827	"range-specification with a negative step"_warn_en_US);
828	}
829	}
830	}
831	}
832	}
833
834	void OmpStructureChecker::CheckIteratorModifier(const parser::OmpIterator &x) {
835	// Check if all iterator variables have integer type.
836	for (auto &&iterSpec : x.v) {
837	bool isInteger{true};
838	auto &typeDecl{std::get<parser::TypeDeclarationStmt>(iterSpec.t)};
839	auto &typeSpec{std::get<parser::DeclarationTypeSpec>(typeDecl.t)};
840	if (!std::holds_alternative<parser::IntrinsicTypeSpec>(typeSpec.u)) {
841	isInteger = false;
842	} else {
843	auto &intrinType{std::get<parser::IntrinsicTypeSpec>(typeSpec.u)};
844	if (!std::holds_alternative<parser::IntegerTypeSpec>(intrinType.u)) {
845	isInteger = false;
846	}
847	}
848	if (!isInteger) {
849	context_.Say(iterSpec.source,
850	"The iterator variable must be of integer type"_err_en_US);
851	}
852	CheckIteratorRange(iterSpec);
853	}
854	}
855
856	void OmpStructureChecker::CheckLoopItrVariableIsInt(
857	const parser::OpenMPLoopConstruct &x) {
858	if (const auto &loopConstruct{
859	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
860
861	for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
862	if (loop->IsDoNormal()) {
863	const parser::Name &itrVal{GetLoopIndex(loop)};
864	if (itrVal.symbol) {
865	const auto *type{itrVal.symbol->GetType()};
866	if (!type->IsNumeric(TypeCategory::Integer)) {
867	context_.Say(itrVal.source,
868	"The DO loop iteration"
869	" variable must be of the type integer."_err_en_US,
870	itrVal.ToString());
871	}
872	}
873	}
874	// Get the next DoConstruct if block is not empty.
875	const auto &block{std::get<parser::Block>(loop->t)};
876	const auto it{block.begin()};
877	loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
878	: nullptr;
879	}
880	}
881	}
882
883	void OmpStructureChecker::CheckSIMDNest(const parser::OpenMPConstruct &c) {
884	// Check the following:
885	// The only OpenMP constructs that can be encountered during execution of
886	// a simd region are the `atomic` construct, the `loop` construct, the `simd`
887	// construct and the `ordered` construct with the `simd` clause.
888
889	// Check if the parent context has the SIMD clause
890	// Please note that we use GetContext() instead of GetContextParent()
891	// because PushContextAndClauseSets() has not been called on the
892	// current context yet.
893	// TODO: Check for declare simd regions.
894	bool eligibleSIMD{false};
895	common::visit(
896	common::visitors{
897	// Allow `!$OMP ORDERED SIMD`
898	[&](const parser::OpenMPBlockConstruct &c) {
899	const auto &beginBlockDir{
900	std::get<parser::OmpBeginBlockDirective>(c.t)};
901	const auto &beginDir{
902	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
903	if (beginDir.v == llvm::omp::Directive::OMPD_ordered) {
904	const auto &clauses{
905	std::get<parser::OmpClauseList>(beginBlockDir.t)};
906	for (const auto &clause : clauses.v) {
907	if (std::get_if<parser::OmpClause::Simd>(&clause.u)) {
908	eligibleSIMD = true;
909	break;
910	}
911	}
912	}
913	},
914	[&](const parser::OpenMPStandaloneConstruct &c) {
915	if (auto *ssc{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(
916	&c.u)}) {
917	llvm::omp::Directive dirId{ssc->v.DirId()};
918	if (dirId == llvm::omp::Directive::OMPD_ordered) {
919	for (const parser::OmpClause &x : ssc->v.Clauses().v) {
920	if (x.Id() == llvm::omp::Clause::OMPC_simd) {
921	eligibleSIMD = true;
922	break;
923	}
924	}
925	} else if (dirId == llvm::omp::Directive::OMPD_scan) {
926	eligibleSIMD = true;
927	}
928	}
929	},
930	// Allowing SIMD and loop construct
931	[&](const parser::OpenMPLoopConstruct &c) {
932	const auto &beginLoopDir{
933	std::get<parser::OmpBeginLoopDirective>(c.t)};
934	const auto &beginDir{
935	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
936	if ((beginDir.v == llvm::omp::Directive::OMPD_simd) ||
937	(beginDir.v == llvm::omp::Directive::OMPD_do_simd) ||
938	(beginDir.v == llvm::omp::Directive::OMPD_loop)) {
939	eligibleSIMD = true;
940	}
941	},
942	[&](const parser::OpenMPAtomicConstruct &c) {
943	// Allow `!$OMP ATOMIC`
944	eligibleSIMD = true;
945	},
946	[&](const auto &c) {},
947	},
948	c.u);
949	if (!eligibleSIMD) {
950	context_.Say(parser::FindSourceLocation(c),
951	"The only OpenMP constructs that can be encountered during execution "
952	"of a 'SIMD' region are the `ATOMIC` construct, the `LOOP` construct, "
953	"the `SIMD` construct, the `SCAN` construct and the `ORDERED` "
954	"construct with the `SIMD` clause."_err_en_US);
955	}
956	}
957
958	void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
959	// 2.12.5 Target Construct Restriction
960	bool eligibleTarget{true};
961	llvm::omp::Directive ineligibleTargetDir;
962	common::visit(
963	common::visitors{
964	[&](const parser::OpenMPBlockConstruct &c) {
965	const auto &beginBlockDir{
966	std::get<parser::OmpBeginBlockDirective>(c.t)};
967	const auto &beginDir{
968	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
969	if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
970	eligibleTarget = false;
971	ineligibleTargetDir = beginDir.v;
972	}
973	},
974	[&](const parser::OpenMPStandaloneConstruct &c) {
975	common::visit(
976	common::visitors{
977	[&](const parser::OpenMPSimpleStandaloneConstruct &c) {
978	switch (llvm::omp::Directive dirId{c.v.DirId()}) {
979	case llvm::omp::Directive::OMPD_target_update:
980	case llvm::omp::Directive::OMPD_target_enter_data:
981	case llvm::omp::Directive::OMPD_target_exit_data:
982	eligibleTarget = false;
983	ineligibleTargetDir = dirId;
984	break;
985	default:
986	break;
987	}
988	},
989	[&](const auto &c) {},
990	},
991	c.u);
992	},
993	[&](const parser::OpenMPLoopConstruct &c) {
994	const auto &beginLoopDir{
995	std::get<parser::OmpBeginLoopDirective>(c.t)};
996	const auto &beginDir{
997	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
998	if (llvm::omp::allTargetSet.test(beginDir.v)) {
999	eligibleTarget = false;
1000	ineligibleTargetDir = beginDir.v;
1001	}
1002	},
1003	[&](const auto &c) {},
1004	},
1005	c.u);
1006	if (!eligibleTarget) {
1007	context_.Warn(common::UsageWarning::OpenMPUsage,
1008	parser::FindSourceLocation(c),
1009	"If %s directive is nested inside TARGET region, the behaviour is unspecified"_port_en_US,
1010	parser::ToUpperCaseLetters(
1011	getDirectiveName(ineligibleTargetDir).str()));
1012	}
1013	}
1014
1015	std::int64_t OmpStructureChecker::GetOrdCollapseLevel(
1016	const parser::OpenMPLoopConstruct &x) {
1017	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1018	const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1019	std::int64_t orderedCollapseLevel{1};
1020	std::int64_t orderedLevel{1};
1021	std::int64_t collapseLevel{1};
1022
1023	for (const auto &clause : clauseList.v) {
1024	if (const auto *collapseClause{
1025	std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
1026	if (const auto v{GetIntValue(collapseClause->v)}) {
1027	collapseLevel = *v;
1028	}
1029	}
1030	if (const auto *orderedClause{
1031	std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
1032	if (const auto v{GetIntValue(orderedClause->v)}) {
1033	orderedLevel = *v;
1034	}
1035	}
1036	}
1037	if (orderedLevel >= collapseLevel) {
1038	orderedCollapseLevel = orderedLevel;
1039	} else {
1040	orderedCollapseLevel = collapseLevel;
1041	}
1042	return orderedCollapseLevel;
1043	}
1044
1045	void OmpStructureChecker::CheckAssociatedLoopConstraints(
1046	const parser::OpenMPLoopConstruct &x) {
1047	std::int64_t ordCollapseLevel{GetOrdCollapseLevel(x)};
1048	AssociatedLoopChecker checker{context_, ordCollapseLevel};
1049	parser::Walk(x, checker);
1050	}
1051
1052	void OmpStructureChecker::CheckDistLinear(
1053	const parser::OpenMPLoopConstruct &x) {
1054
1055	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1056	const auto &clauses{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1057
1058	SymbolSourceMap indexVars;
1059
1060	// Collect symbols of all the variables from linear clauses
1061	for (auto &clause : clauses.v) {
1062	if (auto *linearClause{std::get_if<parser::OmpClause::Linear>(&clause.u)}) {
1063	auto &objects{std::get<parser::OmpObjectList>(linearClause->v.t)};
1064	GetSymbolsInObjectList(objects, indexVars);
1065	}
1066	}
1067
1068	if (!indexVars.empty()) {
1069	// Get collapse level, if given, to find which loops are "associated."
1070	std::int64_t collapseVal{GetOrdCollapseLevel(x)};
1071	// Include the top loop if no collapse is specified
1072	if (collapseVal == 0) {
1073	collapseVal = 1;
1074	}
1075
1076	// Match the loop index variables with the collected symbols from linear
1077	// clauses.
1078	if (const auto &loopConstruct{
1079	std::get<std::optional<parser::DoConstruct>>(x.t)}) {
1080	for (const parser::DoConstruct *loop{&*loopConstruct}; loop;) {
1081	if (loop->IsDoNormal()) {
1082	const parser::Name &itrVal{GetLoopIndex(loop)};
1083	if (itrVal.symbol) {
1084	// Remove the symbol from the collected set
1085	indexVars.erase(&itrVal.symbol->GetUltimate());
1086	}
1087	collapseVal--;
1088	if (collapseVal == 0) {
1089	break;
1090	}
1091	}
1092	// Get the next DoConstruct if block is not empty.
1093	const auto &block{std::get<parser::Block>(loop->t)};
1094	const auto it{block.begin()};
1095	loop = it != block.end() ? parser::Unwrap<parser::DoConstruct>(*it)
1096	: nullptr;
1097	}
1098	}
1099
1100	// Show error for the remaining variables
1101	for (auto &[symbol, source] : indexVars) {
1102	const Symbol &root{GetAssociationRoot(*symbol)};
1103	context_.Say(source,
1104	"Variable '%s' not allowed in LINEAR clause, only loop iterator can be specified in LINEAR clause of a construct combined with DISTRIBUTE"_err_en_US,
1105	root.name());
1106	}
1107	}
1108	}
1109
1110	void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &x) {
1111	const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
1112	const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
1113
1114	// A few semantic checks for InScan reduction are performed below as SCAN
1115	// constructs inside LOOP may add the relevant information. Scan reduction is
1116	// supported only in loop constructs, so same checks are not applicable to
1117	// other directives.
1118	using ReductionModifier = parser::OmpReductionModifier;
1119	for (const auto &clause : clauseList.v) {
1120	if (const auto *reductionClause{
1121	std::get_if<parser::OmpClause::Reduction>(&clause.u)}) {
1122	auto &modifiers{OmpGetModifiers(reductionClause->v)};
1123	auto *maybeModifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)};
1124	if (maybeModifier &&
1125	maybeModifier->v == ReductionModifier::Value::Inscan) {
1126	const auto &objectList{
1127	std::get<parser::OmpObjectList>(reductionClause->v.t)};
1128	auto checkReductionSymbolInScan = [&](const parser::Name *name) {
1129	if (auto &symbol = name->symbol) {
1130	if (!symbol->test(Symbol::Flag::OmpInclusiveScan) &&
1131	!symbol->test(Symbol::Flag::OmpExclusiveScan)) {
1132	context_.Say(name->source,
1133	"List item %s must appear in EXCLUSIVE or "
1134	"INCLUSIVE clause of an "
1135	"enclosed SCAN directive"_err_en_US,
1136	name->ToString());
1137	}
1138	}
1139	};
1140	for (const auto &ompObj : objectList.v) {
1141	common::visit(
1142	common::visitors{
1143	[&](const parser::Designator &designator) {
1144	if (const auto *name{semantics::getDesignatorNameIfDataRef(
1145	designator)}) {
1146	checkReductionSymbolInScan(name);
1147	}
1148	},
1149	[&](const auto &name) { checkReductionSymbolInScan(&name); },
1150	},
1151	ompObj.u);
1152	}
1153	}
1154	}
1155	}
1156	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
1157	ExitDirectiveNest(index: SIMDNest);
1158	}
1159	dirContext_.pop_back();
1160
1161	assert(!loopStack_.empty() && "Expecting non-empty loop stack");
1162	#ifndef NDEBUG
1163	const LoopConstruct &top{loopStack_.back()};
1164	auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&top)};
1165	assert(loopc != nullptr && *loopc == &x && "Mismatched loop constructs");
1166	#endif
1167	loopStack_.pop_back();
1168	}
1169
1170	void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
1171	const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
1172	ResetPartialContext(dir.source);
1173	switch (dir.v) {
1174	// 2.7.1 end-do -> END DO [nowait-clause]
1175	// 2.8.3 end-do-simd -> END DO SIMD [nowait-clause]
1176	case llvm::omp::Directive::OMPD_do:
1177	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_do);
1178	break;
1179	case llvm::omp::Directive::OMPD_do_simd:
1180	PushContextAndClauseSets(
1181	dir.source, llvm::omp::Directive::OMPD_end_do_simd);
1182	break;
1183	default:
1184	// no clauses are allowed
1185	break;
1186	}
1187	}
1188
1189	void OmpStructureChecker::Leave(const parser::OmpEndLoopDirective &x) {
1190	if ((GetContext().directive == llvm::omp::Directive::OMPD_end_do) ||
1191	(GetContext().directive == llvm::omp::Directive::OMPD_end_do_simd)) {
1192	dirContext_.pop_back();
1193	}
1194	}
1195
1196	void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
1197	const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
1198	const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
1199	const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
1200	const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
1201	const parser::Block &block{std::get<parser::Block>(x.t)};
1202
1203	CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
1204
1205	PushContextAndClauseSets(beginDir.source, beginDir.v);
1206	if (llvm::omp::allTargetSet.test(GetContext().directive)) {
1207	EnterDirectiveNest(index: TargetNest);
1208	}
1209
1210	if (CurrentDirectiveIsNested()) {
1211	if (llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
1212	HasInvalidTeamsNesting(beginDir.v, beginDir.source);
1213	}
1214	if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
1215	CheckMasterNesting(x);
1216	}
1217	// A teams region can only be strictly nested within the implicit parallel
1218	// region or a target region.
1219	if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
1220	GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
1221	context_.Say(parser::FindSourceLocation(x),
1222	"%s region can only be strictly nested within the implicit parallel "
1223	"region or TARGET region"_err_en_US,
1224	ContextDirectiveAsFortran());
1225	}
1226	// If a teams construct is nested within a target construct, that target
1227	// construct must contain no statements, declarations or directives outside
1228	// of the teams construct.
1229	if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
1230	GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
1231	!GetDirectiveNest(TargetBlockOnlyTeams)) {
1232	context_.Say(GetContextParent().directiveSource,
1233	"TARGET construct with nested TEAMS region contains statements or "
1234	"directives outside of the TEAMS construct"_err_en_US);
1235	}
1236	}
1237
1238	CheckNoBranching(block, beginDir.v, beginDir.source);
1239
1240	// Target block constructs are target device constructs. Keep track of
1241	// whether any such construct has been visited to later check that REQUIRES
1242	// directives for target-related options don't appear after them.
1243	if (llvm::omp::allTargetSet.test(beginDir.v)) {
1244	deviceConstructFound_ = true;
1245	}
1246
1247	if (GetContext().directive == llvm::omp::Directive::OMPD_single) {
1248	std::set<Symbol *> singleCopyprivateSyms;
1249	std::set<Symbol *> endSingleCopyprivateSyms;
1250	bool foundNowait{false};
1251	parser::CharBlock NowaitSource;
1252
1253	auto catchCopyPrivateNowaitClauses = [&](const auto &dir, bool endDir) {
1254	for (auto &clause : std::get<parser::OmpClauseList>(dir.t).v) {
1255	if (clause.Id() == llvm::omp::Clause::OMPC_copyprivate) {
1256	for (const auto &ompObject : GetOmpObjectList(clause)->v) {
1257	const auto *name{parser::Unwrap<parser::Name>(ompObject)};
1258	if (Symbol * symbol{name->symbol}) {
1259	if (singleCopyprivateSyms.count(symbol)) {
1260	if (endDir) {
1261	context_.Warn(common::UsageWarning::OpenMPUsage, name->source,
1262	"The COPYPRIVATE clause with '%s' is already used on the SINGLE directive"_warn_en_US,
1263	name->ToString());
1264	} else {
1265	context_.Say(name->source,
1266	"'%s' appears in more than one COPYPRIVATE clause on the SINGLE directive"_err_en_US,
1267	name->ToString());
1268	}
1269	} else if (endSingleCopyprivateSyms.count(symbol)) {
1270	context_.Say(name->source,
1271	"'%s' appears in more than one COPYPRIVATE clause on the END SINGLE directive"_err_en_US,
1272	name->ToString());
1273	} else {
1274	if (endDir) {
1275	endSingleCopyprivateSyms.insert(symbol);
1276	} else {
1277	singleCopyprivateSyms.insert(symbol);
1278	}
1279	}
1280	}
1281	}
1282	} else if (clause.Id() == llvm::omp::Clause::OMPC_nowait) {
1283	if (foundNowait) {
1284	context_.Say(clause.source,
1285	"At most one NOWAIT clause can appear on the SINGLE directive"_err_en_US);
1286	} else {
1287	foundNowait = !endDir;
1288	}
1289	if (!NowaitSource.ToString().size()) {
1290	NowaitSource = clause.source;
1291	}
1292	}
1293	}
1294	};
1295	catchCopyPrivateNowaitClauses(beginBlockDir, false);
1296	catchCopyPrivateNowaitClauses(endBlockDir, true);
1297	unsigned version{context_.langOptions().OpenMPVersion};
1298	if (version <= 52 && NowaitSource.ToString().size() &&
1299	(singleCopyprivateSyms.size() || endSingleCopyprivateSyms.size())) {
1300	context_.Say(NowaitSource,
1301	"NOWAIT clause must not be used with COPYPRIVATE clause on the SINGLE directive"_err_en_US);
1302	}
1303	}
1304
1305	switch (beginDir.v) {
1306	case llvm::omp::Directive::OMPD_target:
1307	if (CheckTargetBlockOnlyTeams(block)) {
1308	EnterDirectiveNest(index: TargetBlockOnlyTeams);
1309	}
1310	break;
1311	case llvm::omp::OMPD_workshare:
1312	case llvm::omp::OMPD_parallel_workshare:
1313	CheckWorkshareBlockStmts(block, beginDir.source);
1314	HasInvalidWorksharingNesting(
1315	beginDir.source, llvm::omp::nestedWorkshareErrSet);
1316	break;
1317	case llvm::omp::Directive::OMPD_scope:
1318	case llvm::omp::Directive::OMPD_single:
1319	// TODO: This check needs to be extended while implementing nesting of
1320	// regions checks.
1321	HasInvalidWorksharingNesting(
1322	beginDir.source, llvm::omp::nestedWorkshareErrSet);
1323	break;
1324	case llvm::omp::Directive::OMPD_task: {
1325	const auto &clauses{std::get<parser::OmpClauseList>(beginBlockDir.t)};
1326	for (const auto &clause : clauses.v) {
1327	if (std::get_if<parser::OmpClause::Untied>(&clause.u)) {
1328	OmpUnitedTaskDesignatorChecker check{context_};
1329	parser::Walk(block, check);
1330	}
1331	}
1332	break;
1333	}
1334	default:
1335	break;
1336	}
1337	}
1338
1339	void OmpStructureChecker::CheckMasterNesting(
1340	const parser::OpenMPBlockConstruct &x) {
1341	// A MASTER region may not be `closely nested` inside a worksharing, loop,
1342	// task, taskloop, or atomic region.
1343	// TODO: Expand the check to include `LOOP` construct as well when it is
1344	// supported.
1345	if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
1346	context_.Say(parser::FindSourceLocation(x),
1347	"`MASTER` region may not be closely nested inside of `WORKSHARING`, "
1348	"`LOOP`, `TASK`, `TASKLOOP`,"
1349	" or `ATOMIC` region."_err_en_US);
1350	}
1351	}
1352
1353	void OmpStructureChecker::Enter(const parser::OpenMPAssumeConstruct &x) {
1354	PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assume);
1355	}
1356
1357	void OmpStructureChecker::Leave(const parser::OpenMPAssumeConstruct &) {
1358	dirContext_.pop_back();
1359	}
1360
1361	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAssumes &x) {
1362	PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assumes);
1363	}
1364
1365	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAssumes &) {
1366	dirContext_.pop_back();
1367	}
1368
1369	void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
1370	if (GetDirectiveNest(index: TargetBlockOnlyTeams)) {
1371	ExitDirectiveNest(index: TargetBlockOnlyTeams);
1372	}
1373	if (llvm::omp::allTargetSet.test(GetContext().directive)) {
1374	ExitDirectiveNest(index: TargetNest);
1375	}
1376	dirContext_.pop_back();
1377	}
1378
1379	void OmpStructureChecker::ChecksOnOrderedAsBlock() {
1380	if (FindClause(llvm::omp::Clause::OMPC_depend)) {
1381	context_.Say(GetContext().clauseSource,
1382	"DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region"_err_en_US);
1383	return;
1384	}
1385
1386	bool isNestedInDo{false};
1387	bool isNestedInDoSIMD{false};
1388	bool isNestedInSIMD{false};
1389	bool noOrderedClause{false};
1390	bool isOrderedClauseWithPara{false};
1391	bool isCloselyNestedRegion{true};
1392	if (CurrentDirectiveIsNested()) {
1393	for (int i = (int)dirContext_.size() - 2; i >= 0; i--) {
1394	if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) {
1395	context_.Say(GetContext().directiveSource,
1396	"`ORDERED` region may not be closely nested inside of `CRITICAL`, "
1397	"`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
1398	break;
1399	} else if (llvm::omp::allDoSet.test(dirContext_[i].directive)) {
1400	isNestedInDo = true;
1401	isNestedInDoSIMD =
1402	llvm::omp::allDoSimdSet.test(dirContext_[i].directive);
1403	if (const auto *clause{
1404	FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) {
1405	const auto &orderedClause{
1406	std::get<parser::OmpClause::Ordered>(clause->u)};
1407	const auto orderedValue{GetIntValue(orderedClause.v)};
1408	isOrderedClauseWithPara = orderedValue > 0;
1409	} else {
1410	noOrderedClause = true;
1411	}
1412	break;
1413	} else if (llvm::omp::allSimdSet.test(dirContext_[i].directive)) {
1414	isNestedInSIMD = true;
1415	break;
1416	} else if (llvm::omp::nestedOrderedParallelErrSet.test(
1417	dirContext_[i].directive)) {
1418	isCloselyNestedRegion = false;
1419	break;
1420	}
1421	}
1422	}
1423
1424	if (!isCloselyNestedRegion) {
1425	context_.Say(GetContext().directiveSource,
1426	"An ORDERED directive without the DEPEND clause must be closely nested "
1427	"in a SIMD, worksharing-loop, or worksharing-loop SIMD "
1428	"region"_err_en_US);
1429	} else {
1430	if (CurrentDirectiveIsNested() &&
1431	FindClause(llvm::omp::Clause::OMPC_simd) &&
1432	(!isNestedInDoSIMD && !isNestedInSIMD)) {
1433	context_.Say(GetContext().directiveSource,
1434	"An ORDERED directive with SIMD clause must be closely nested in a "
1435	"SIMD or worksharing-loop SIMD region"_err_en_US);
1436	}
1437	if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) {
1438	context_.Say(GetContext().directiveSource,
1439	"An ORDERED directive without the DEPEND clause must be closely "
1440	"nested in a worksharing-loop (or worksharing-loop SIMD) region with "
1441	"ORDERED clause without the parameter"_err_en_US);
1442	}
1443	}
1444	}
1445
1446	void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
1447	switch (GetContext().directive) {
1448	case llvm::omp::Directive::OMPD_ordered:
1449	// [5.1] 2.19.9 Ordered Construct Restriction
1450	ChecksOnOrderedAsBlock();
1451	break;
1452	default:
1453	break;
1454	}
1455	}
1456
1457	void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
1458	const auto &beginSectionsDir{
1459	std::get<parser::OmpBeginSectionsDirective>(x.t)};
1460	const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
1461	const auto &beginDir{
1462	std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1463	const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
1464	CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
1465
1466	PushContextAndClauseSets(beginDir.source, beginDir.v);
1467	AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endSectionsDir.t));
1468
1469	const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
1470	for (const parser::OpenMPConstruct &block : sectionBlocks.v) {
1471	CheckNoBranching(std::get<parser::OpenMPSectionConstruct>(block.u).v,
1472	beginDir.v, beginDir.source);
1473	}
1474	HasInvalidWorksharingNesting(
1475	beginDir.source, llvm::omp::nestedWorkshareErrSet);
1476	}
1477
1478	void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
1479	dirContext_.pop_back();
1480	}
1481
1482	void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
1483	const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
1484	ResetPartialContext(dir.source);
1485	switch (dir.v) {
1486	// 2.7.2 end-sections -> END SECTIONS [nowait-clause]
1487	case llvm::omp::Directive::OMPD_sections:
1488	PushContextAndClauseSets(
1489	dir.source, llvm::omp::Directive::OMPD_end_sections);
1490	break;
1491	default:
1492	// no clauses are allowed
1493	break;
1494	}
1495	}
1496
1497	// TODO: Verify the popping of dirContext requirement after nowait
1498	// implementation, as there is an implicit barrier at the end of the worksharing
1499	// constructs unless a nowait clause is specified. Only OMPD_end_sections is
1500	// popped becuase it is pushed while entering the EndSectionsDirective.
1501	void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
1502	if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
1503	dirContext_.pop_back();
1504	}
1505	}
1506
1507	void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
1508	const parser::OmpObjectList &objList) {
1509	for (const auto &ompObject : objList.v) {
1510	common::visit(
1511	common::visitors{
1512	[&](const parser::Designator &) {
1513	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1514	// The symbol is null, return early, CheckSymbolNames
1515	// should have already reported the missing symbol as a
1516	// diagnostic error
1517	if (!name->symbol) {
1518	return;
1519	}
1520
1521	if (name->symbol->GetUltimate().IsSubprogram()) {
1522	if (GetContext().directive ==
1523	llvm::omp::Directive::OMPD_threadprivate)
1524	context_.Say(name->source,
1525	"The procedure name cannot be in a %s "
1526	"directive"_err_en_US,
1527	ContextDirectiveAsFortran());
1528	// TODO: Check for procedure name in declare target directive.
1529	} else if (name->symbol->attrs().test(Attr::PARAMETER)) {
1530	if (GetContext().directive ==
1531	llvm::omp::Directive::OMPD_threadprivate)
1532	context_.Say(name->source,
1533	"The entity with PARAMETER attribute cannot be in a %s "
1534	"directive"_err_en_US,
1535	ContextDirectiveAsFortran());
1536	else if (GetContext().directive ==
1537	llvm::omp::Directive::OMPD_declare_target)
1538	context_.Warn(common::UsageWarning::OpenMPUsage,
1539	name->source,
1540	"The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,
1541	ContextDirectiveAsFortran());
1542	} else if (FindCommonBlockContaining(*name->symbol)) {
1543	context_.Say(name->source,
1544	"A variable in a %s directive cannot be an element of a "
1545	"common block"_err_en_US,
1546	ContextDirectiveAsFortran());
1547	} else if (FindEquivalenceSet(*name->symbol)) {
1548	context_.Say(name->source,
1549	"A variable in a %s directive cannot appear in an "
1550	"EQUIVALENCE statement"_err_en_US,
1551	ContextDirectiveAsFortran());
1552	} else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) &&
1553	GetContext().directive ==
1554	llvm::omp::Directive::OMPD_declare_target) {
1555	context_.Say(name->source,
1556	"A THREADPRIVATE variable cannot appear in a %s "
1557	"directive"_err_en_US,
1558	ContextDirectiveAsFortran());
1559	} else {
1560	const semantics::Scope &useScope{
1561	context_.FindScope(GetContext().directiveSource)};
1562	const semantics::Scope &curScope =
1563	name->symbol->GetUltimate().owner();
1564	if (!curScope.IsTopLevel()) {
1565	const semantics::Scope &declScope =
1566	GetProgramUnitOrBlockConstructContaining(curScope);
1567	const semantics::Symbol *sym{
1568	declScope.parent().FindSymbol(name->symbol->name())};
1569	if (sym &&
1570	(sym->has<MainProgramDetails>() ||
1571	sym->has<ModuleDetails>())) {
1572	context_.Say(name->source,
1573	"The module name or main program name cannot be in a "
1574	"%s "
1575	"directive"_err_en_US,
1576	ContextDirectiveAsFortran());
1577	} else if (!IsSaved(*name->symbol) &&
1578	declScope.kind() != Scope::Kind::MainProgram &&
1579	declScope.kind() != Scope::Kind::Module) {
1580	context_.Say(name->source,
1581	"A variable that appears in a %s directive must be "
1582	"declared in the scope of a module or have the SAVE "
1583	"attribute, either explicitly or "
1584	"implicitly"_err_en_US,
1585	ContextDirectiveAsFortran());
1586	} else if (useScope != declScope) {
1587	context_.Say(name->source,
1588	"The %s directive and the common block or variable "
1589	"in it must appear in the same declaration section "
1590	"of a scoping unit"_err_en_US,
1591	ContextDirectiveAsFortran());
1592	}
1593	}
1594	}
1595	}
1596	},
1597	[&](const parser::Name &name) {
1598	if (name.symbol) {
1599	if (auto *cb{name.symbol->detailsIf<CommonBlockDetails>()}) {
1600	for (const auto &obj : cb->objects()) {
1601	if (FindEquivalenceSet(*obj)) {
1602	context_.Say(name.source,
1603	"A variable in a %s directive cannot appear in an EQUIVALENCE statement (variable '%s' from common block '/%s/')"_err_en_US,
1604	ContextDirectiveAsFortran(), obj->name(),
1605	name.symbol->name());
1606	}
1607	}
1608	}
1609	}
1610	},
1611	},
1612	ompObject.u);
1613	}
1614	}
1615
1616	void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
1617	const auto &dir{std::get<parser::Verbatim>(c.t)};
1618	PushContextAndClauseSets(
1619	dir.source, llvm::omp::Directive::OMPD_threadprivate);
1620	}
1621
1622	void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
1623	const auto &dir{std::get<parser::Verbatim>(c.t)};
1624	const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
1625	CheckSymbolNames(dir.source, objectList);
1626	CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
1627	CheckThreadprivateOrDeclareTargetVar(objectList);
1628	dirContext_.pop_back();
1629	}
1630
1631	void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
1632	const auto &dir{std::get<parser::Verbatim>(x.t)};
1633	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
1634	}
1635
1636	void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
1637	dirContext_.pop_back();
1638	}
1639
1640	void OmpStructureChecker::Enter(const parser::OmpDeclareVariantDirective &x) {
1641	const auto &dir{std::get<parser::Verbatim>(x.t)};
1642	PushContextAndClauseSets(
1643	dir.source, llvm::omp::Directive::OMPD_declare_variant);
1644	}
1645
1646	void OmpStructureChecker::Leave(const parser::OmpDeclareVariantDirective &) {
1647	dirContext_.pop_back();
1648	}
1649
1650	void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
1651	const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
1652	PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_depobj);
1653	unsigned version{context_.langOptions().OpenMPVersion};
1654
1655	const parser::OmpArgumentList &arguments{x.v.Arguments()};
1656	const parser::OmpClauseList &clauses{x.v.Clauses()};
1657
1658	// Ref: [6.0:505-506]
1659
1660	if (version < 60) {
1661	if (arguments.v.size() != 1) {
1662	parser::CharBlock source(
1663	arguments.v.empty() ? dirName.source : arguments.source);
1664	context_.Say(
1665	source, "The DEPOBJ directive requires a single argument"_err_en_US);
1666	}
1667	}
1668	if (clauses.v.size() != 1) {
1669	context_.Say(
1670	x.source, "The DEPOBJ construct requires a single clause"_err_en_US);
1671	return;
1672	}
1673
1674	auto &clause{clauses.v.front()};
1675
1676	if (version >= 60 && arguments.v.empty()) {
1677	context_.Say(x.source,
1678	"DEPOBJ syntax with no argument is not handled yet"_err_en_US);
1679	return;
1680	}
1681
1682	// [5.2:73:27-28]
1683	// If the destroy clause appears on a depobj construct, destroy-var must
1684	// refer to the same depend object as the depobj argument of the construct.
1685	if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {
1686	auto getObjSymbol{[&](const parser::OmpObject &obj) {
1687	return common::visit(
1688	[&](auto &&s) { return GetLastName(s).symbol; }, obj.u);
1689	}};
1690	auto getArgSymbol{[&](const parser::OmpArgument &arg) {
1691	if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {
1692	if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
1693	return getObjSymbol(*object);
1694	}
1695	}
1696	return static_cast<Symbol *>(nullptr);
1697	}};
1698
1699	auto &wrapper{std::get<parser::OmpClause::Destroy>(clause.u)};
1700	if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {
1701	const Symbol *constrSym{getArgSymbol(arguments.v.front())};
1702	const Symbol *clauseSym{getObjSymbol(destroy->v)};
1703	assert(constrSym && "Unresolved depobj construct symbol");
1704	assert(clauseSym && "Unresolved destroy symbol on depobj construct");
1705	if (constrSym != clauseSym) {
1706	context_.Say(x.source,
1707	"The DESTROY clause must refer to the same object as the "
1708	"DEPOBJ construct"_err_en_US);
1709	}
1710	}
1711	}
1712	}
1713
1714	void OmpStructureChecker::Leave(const parser::OpenMPDepobjConstruct &x) {
1715	dirContext_.pop_back();
1716	}
1717
1718	void OmpStructureChecker::Enter(const parser::OpenMPRequiresConstruct &x) {
1719	const auto &dir{std::get<parser::Verbatim>(x.t)};
1720	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_requires);
1721	}
1722
1723	void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
1724	dirContext_.pop_back();
1725	}
1726
1727	void OmpStructureChecker::CheckAlignValue(const parser::OmpClause &clause) {
1728	if (auto *align{std::get_if<parser::OmpClause::Align>(&clause.u)}) {
1729	if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
1730	context_.Say(clause.source,
1731	"The alignment value should be a constant positive integer"_err_en_US);
1732	}
1733	}
1734	}
1735
1736	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
1737	isPredefinedAllocator = true;
1738	const auto &dir{std::get<parser::Verbatim>(x.t)};
1739	const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1740	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1741	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1742	SymbolSourceMap currSymbols;
1743	GetSymbolsInObjectList(objectList, currSymbols);
1744	for (auto &[symbol, source] : currSymbols) {
1745	if (IsPointer(*symbol)) {
1746	context_.Say(source,
1747	"List item '%s' in ALLOCATE directive must not have POINTER "
1748	"attribute"_err_en_US,
1749	source.ToString());
1750	}
1751	if (IsDummy(*symbol)) {
1752	context_.Say(source,
1753	"List item '%s' in ALLOCATE directive must not be a dummy "
1754	"argument"_err_en_US,
1755	source.ToString());
1756	}
1757	if (symbol->GetUltimate().has<AssocEntityDetails>()) {
1758	context_.Say(source,
1759	"List item '%s' in ALLOCATE directive must not be an associate "
1760	"name"_err_en_US,
1761	source.ToString());
1762	}
1763	}
1764	for (const auto &clause : clauseList.v) {
1765	CheckAlignValue(clause);
1766	}
1767	CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
1768	}
1769
1770	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
1771	const auto &dir{std::get<parser::Verbatim>(x.t)};
1772	const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1773	CheckPredefinedAllocatorRestriction(dir.source, objectList);
1774	dirContext_.pop_back();
1775	}
1776
1777	void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
1778	CheckAllowedClause(llvm::omp::Clause::OMPC_allocator);
1779	// Note: Predefined allocators are stored in ScalarExpr as numbers
1780	// whereas custom allocators are stored as strings, so if the ScalarExpr
1781	// actually has an int value, then it must be a predefined allocator
1782	isPredefinedAllocator = GetIntValue(x.v).has_value();
1783	RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
1784	}
1785
1786	void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {
1787	CheckAllowedClause(llvm::omp::Clause::OMPC_allocate);
1788	if (OmpVerifyModifiers(
1789	x.v, llvm::omp::OMPC_allocate, GetContext().clauseSource, context_)) {
1790	auto &modifiers{OmpGetModifiers(x.v)};
1791	if (auto *align{
1792	OmpGetUniqueModifier<parser::OmpAlignModifier>(modifiers)}) {
1793	if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
1794	context_.Say(OmpGetModifierSource(modifiers, align),
1795	"The alignment value should be a constant positive integer"_err_en_US);
1796	}
1797	}
1798	// The simple and complex modifiers have the same structure. They only
1799	// differ in their syntax.
1800	if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorComplexModifier>(
1801	modifiers)}) {
1802	isPredefinedAllocator = GetIntValue(alloc->v).has_value();
1803	}
1804	if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorSimpleModifier>(
1805	modifiers)}) {
1806	isPredefinedAllocator = GetIntValue(alloc->v).has_value();
1807	}
1808	}
1809	}
1810
1811	void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithClause &x) {
1812	SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
1813	}
1814
1815	void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
1816	if (x.v.v.size() > 0) {
1817	const parser::OmpClause *enterClause =
1818	FindClause(llvm::omp::Clause::OMPC_enter);
1819	const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);
1820	const parser::OmpClause *linkClause =
1821	FindClause(llvm::omp::Clause::OMPC_link);
1822	if (!enterClause && !toClause && !linkClause) {
1823	context_.Say(x.source,
1824	"If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US);
1825	}
1826	unsigned version{context_.langOptions().OpenMPVersion};
1827	if (toClause && version >= 52) {
1828	context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source,
1829	"The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);
1830	}
1831	}
1832	}
1833
1834	void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {
1835	const auto &dir{std::get<parser::Verbatim>(x.t)};
1836	PushContextAndClauseSets(
1837	dir.source, llvm::omp::Directive::OMPD_declare_mapper);
1838	const auto &spec{std::get<parser::OmpMapperSpecifier>(x.t)};
1839	const auto &type = std::get<parser::TypeSpec>(spec.t);
1840	if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {
1841	context_.Say(dir.source, "Type is not a derived type"_err_en_US);
1842	}
1843	}
1844
1845	void OmpStructureChecker::Leave(const parser::OpenMPDeclareMapperConstruct &) {
1846	dirContext_.pop_back();
1847	}
1848
1849	void OmpStructureChecker::Enter(
1850	const parser::OpenMPDeclareReductionConstruct &x) {
1851	const auto &dir{std::get<parser::Verbatim>(x.t)};
1852	PushContextAndClauseSets(
1853	dir.source, llvm::omp::Directive::OMPD_declare_reduction);
1854	}
1855
1856	void OmpStructureChecker::Leave(
1857	const parser::OpenMPDeclareReductionConstruct &) {
1858	dirContext_.pop_back();
1859	}
1860
1861	void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
1862	const auto &dir{std::get<parser::Verbatim>(x.t)};
1863	PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
1864	}
1865
1866	void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
1867	SymbolSourceMap symbols;
1868	GetSymbolsInObjectList(x.v, symbols);
1869	for (auto &[symbol, source] : symbols) {
1870	const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();
1871	if (genericDetails) {
1872	context_.Say(source,
1873	"The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,
1874	symbol->name());
1875	genericDetails->specific();
1876	}
1877	if (IsProcedurePointer(*symbol)) {
1878	context_.Say(source,
1879	"The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,
1880	symbol->name());
1881	}
1882	const SubprogramDetails *entryDetails =
1883	symbol->detailsIf<SubprogramDetails>();
1884	if (entryDetails && entryDetails->entryScope()) {
1885	context_.Say(source,
1886	"The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,
1887	symbol->name());
1888	}
1889	if (IsStmtFunction(*symbol)) {
1890	context_.Say(source,
1891	"The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,
1892	symbol->name());
1893	}
1894	}
1895	}
1896
1897	void OmpStructureChecker::CheckSymbolNames(
1898	const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1899	for (const auto &ompObject : objList.v) {
1900	common::visit(
1901	common::visitors{
1902	[&](const parser::Designator &designator) {
1903	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1904	if (!name->symbol) {
1905	context_.Say(source,
1906	"The given %s directive clause has an invalid argument"_err_en_US,
1907	ContextDirectiveAsFortran());
1908	}
1909	}
1910	},
1911	[&](const parser::Name &name) {
1912	if (!name.symbol) {
1913	context_.Say(source,
1914	"The given %s directive clause has an invalid argument"_err_en_US,
1915	ContextDirectiveAsFortran());
1916	}
1917	},
1918	},
1919	ompObject.u);
1920	}
1921	}
1922
1923	void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {
1924	const auto &dir{std::get<parser::Verbatim>(x.t)};
1925	const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1926	// Handle both forms of DECLARE TARGET.
1927	// - Extended list: It behaves as if there was an ENTER/TO clause with the
1928	// list of objects as argument. It accepts no explicit clauses.
1929	// - With clauses.
1930	if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1931	deviceConstructFound_ = true;
1932	CheckSymbolNames(dir.source, *objectList);
1933	CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
1934	CheckThreadprivateOrDeclareTargetVar(*objectList);
1935	} else if (const auto *clauseList{
1936	parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1937	bool toClauseFound{false}, deviceTypeClauseFound{false},
1938	enterClauseFound{false};
1939	for (const auto &clause : clauseList->v) {
1940	common::visit(
1941	common::visitors{
1942	[&](const parser::OmpClause::To &toClause) {
1943	toClauseFound = true;
1944	auto &objList{std::get<parser::OmpObjectList>(toClause.v.t)};
1945	CheckSymbolNames(dir.source, objList);
1946	CheckVarIsNotPartOfAnotherVar(dir.source, objList);
1947	CheckThreadprivateOrDeclareTargetVar(objList);
1948	},
1949	[&](const parser::OmpClause::Link &linkClause) {
1950	CheckSymbolNames(dir.source, linkClause.v);
1951	CheckVarIsNotPartOfAnotherVar(dir.source, linkClause.v);
1952	CheckThreadprivateOrDeclareTargetVar(linkClause.v);
1953	},
1954	[&](const parser::OmpClause::Enter &enterClause) {
1955	enterClauseFound = true;
1956	CheckSymbolNames(dir.source, enterClause.v);
1957	CheckVarIsNotPartOfAnotherVar(dir.source, enterClause.v);
1958	CheckThreadprivateOrDeclareTargetVar(enterClause.v);
1959	},
1960	[&](const parser::OmpClause::DeviceType &deviceTypeClause) {
1961	deviceTypeClauseFound = true;
1962	if (deviceTypeClause.v.v !=
1963	parser::OmpDeviceTypeClause::DeviceTypeDescription::Host) {
1964	// Function / subroutine explicitly marked as runnable by the
1965	// target device.
1966	deviceConstructFound_ = true;
1967	}
1968	},
1969	[&](const auto &) {},
1970	},
1971	clause.u);
1972
1973	if ((toClauseFound || enterClauseFound) && !deviceTypeClauseFound) {
1974	deviceConstructFound_ = true;
1975	}
1976	}
1977	}
1978	dirContext_.pop_back();
1979	}
1980
1981	void OmpStructureChecker::Enter(const parser::OmpErrorDirective &x) {
1982	const auto &dir{std::get<parser::Verbatim>(x.t)};
1983	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_error);
1984	}
1985
1986	void OmpStructureChecker::Enter(const parser::OpenMPDispatchConstruct &x) {
1987	PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_dispatch);
1988	const auto &block{std::get<parser::Block>(x.t)};
1989	if (block.empty() || block.size() > 1) {
1990	context_.Say(x.source,
1991	"The DISPATCH construct is empty or contains more than one statement"_err_en_US);
1992	return;
1993	}
1994
1995	auto it{block.begin()};
1996	bool passChecks{false};
1997	if (const parser::AssignmentStmt *
1998	assignStmt{parser::Unwrap<parser::AssignmentStmt>(*it)}) {
1999	if (parser::Unwrap<parser::FunctionReference>(assignStmt->t)) {
2000	passChecks = true;
2001	}
2002	} else if (parser::Unwrap<parser::CallStmt>(*it)) {
2003	passChecks = true;
2004	}
2005
2006	if (!passChecks) {
2007	context_.Say(x.source,
2008	"The DISPATCH construct does not contain a SUBROUTINE or FUNCTION"_err_en_US);
2009	}
2010	}
2011
2012	void OmpStructureChecker::Leave(const parser::OpenMPDispatchConstruct &x) {
2013	dirContext_.pop_back();
2014	}
2015
2016	void OmpStructureChecker::Leave(const parser::OmpErrorDirective &x) {
2017	dirContext_.pop_back();
2018	}
2019
2020	void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
2021	CheckAllowedClause(llvm::omp::Clause::OMPC_at);
2022	if (GetDirectiveNest(index: DeclarativeNest) > 0) {
2023	if (x.v.v == parser::OmpAtClause::ActionTime::Execution) {
2024	context_.Say(GetContext().clauseSource,
2025	"The ERROR directive with AT(EXECUTION) cannot appear in the specification part"_err_en_US);
2026	}
2027	}
2028	}
2029
2030	void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
2031	isPredefinedAllocator = true;
2032	const auto &dir{std::get<parser::Verbatim>(x.t)};
2033	const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
2034	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
2035	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2036	for (const auto &clause : clauseList.v) {
2037	CheckAlignValue(clause);
2038	}
2039	if (objectList) {
2040	CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
2041	}
2042	}
2043
2044	void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
2045	const auto &dir{std::get<parser::Verbatim>(x.t)};
2046	const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
2047	if (objectList)
2048	CheckPredefinedAllocatorRestriction(dir.source, *objectList);
2049	dirContext_.pop_back();
2050	}
2051
2052	void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
2053	isPredefinedAllocator = true;
2054	const auto &dir{std::get<parser::Verbatim>(x.t)};
2055	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocators);
2056	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2057	for (const auto &clause : clauseList.v) {
2058	if (const auto *allocClause{
2059	parser::Unwrap<parser::OmpClause::Allocate>(clause)}) {
2060	CheckVarIsNotPartOfAnotherVar(
2061	dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
2062	}
2063	}
2064	}
2065
2066	void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {
2067	const auto &dir{std::get<parser::Verbatim>(x.t)};
2068	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
2069	for (const auto &clause : clauseList.v) {
2070	if (const auto *allocClause{
2071	std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
2072	CheckPredefinedAllocatorRestriction(
2073	dir.source, std::get<parser::OmpObjectList>(allocClause->v.t));
2074	}
2075	}
2076	dirContext_.pop_back();
2077	}
2078
2079	void OmpStructureChecker::CheckScan(
2080	const parser::OpenMPSimpleStandaloneConstruct &x) {
2081	if (x.v.Clauses().v.size() != 1) {
2082	context_.Say(x.source,
2083	"Exactly one of EXCLUSIVE or INCLUSIVE clause is expected"_err_en_US);
2084	}
2085	if (!CurrentDirectiveIsNested() ||
2086	!llvm::omp::scanParentAllowedSet.test(GetContextParent().directive)) {
2087	context_.Say(x.source,
2088	"Orphaned SCAN directives are prohibited; perhaps you forgot "
2089	"to enclose the directive in to a WORKSHARING LOOP, a WORKSHARING "
2090	"LOOP SIMD or a SIMD directive."_err_en_US);
2091	}
2092	}
2093
2094	void OmpStructureChecker::CheckBarrierNesting(
2095	const parser::OpenMPSimpleStandaloneConstruct &x) {
2096	// A barrier region may not be `closely nested` inside a worksharing, loop,
2097	// task, taskloop, critical, ordered, atomic, or master region.
2098	// TODO: Expand the check to include `LOOP` construct as well when it is
2099	// supported.
2100	if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
2101	context_.Say(parser::FindSourceLocation(x),
2102	"`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
2103	"`LOOP`, `TASK`, `TASKLOOP`,"
2104	"`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
2105	}
2106	}
2107
2108	void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
2109	if (FindClause(llvm::omp::Clause::OMPC_threads) ||
2110	FindClause(llvm::omp::Clause::OMPC_simd)) {
2111	context_.Say(GetContext().clauseSource,
2112	"THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
2113	}
2114
2115	int dependSinkCount{0}, dependSourceCount{0};
2116	bool exclusiveShown{false}, duplicateSourceShown{false};
2117
2118	auto visitDoacross{[&](const parser::OmpDoacross &doa,
2119	const parser::CharBlock &src) {
2120	common::visit(
2121	common::visitors{
2122	[&](const parser::OmpDoacross::Source &) { dependSourceCount++; },
2123	[&](const parser::OmpDoacross::Sink &) { dependSinkCount++; }},
2124	doa.u);
2125	if (!exclusiveShown && dependSinkCount > 0 && dependSourceCount > 0) {
2126	exclusiveShown = true;
2127	context_.Say(src,
2128	"The SINK and SOURCE dependence types are mutually exclusive"_err_en_US);
2129	}
2130	if (!duplicateSourceShown && dependSourceCount > 1) {
2131	duplicateSourceShown = true;
2132	context_.Say(src,
2133	"At most one SOURCE dependence type can appear on the ORDERED directive"_err_en_US);
2134	}
2135	}};
2136
2137	// Visit the DEPEND and DOACROSS clauses.
2138	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
2139	const auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
2140	if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
2141	visitDoacross(*doAcross, clause->source);
2142	} else {
2143	context_.Say(clause->source,
2144	"Only SINK or SOURCE dependence types are allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
2145	}
2146	}
2147	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
2148	auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
2149	visitDoacross(doaClause.v.v, clause->source);
2150	}
2151
2152	bool isNestedInDoOrderedWithPara{false};
2153	if (CurrentDirectiveIsNested() &&
2154	llvm::omp::nestedOrderedDoAllowedSet.test(GetContextParent().directive)) {
2155	if (const auto *clause{
2156	FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) {
2157	const auto &orderedClause{
2158	std::get<parser::OmpClause::Ordered>(clause->u)};
2159	const auto orderedValue{GetIntValue(orderedClause.v)};
2160	if (orderedValue > 0) {
2161	isNestedInDoOrderedWithPara = true;
2162	CheckOrderedDependClause(orderedValue: orderedValue);
2163	}
2164	}
2165	}
2166
2167	if (FindClause(llvm::omp::Clause::OMPC_depend) &&
2168	!isNestedInDoOrderedWithPara) {
2169	context_.Say(GetContext().clauseSource,
2170	"An ORDERED construct with the DEPEND clause must be closely nested "
2171	"in a worksharing-loop (or parallel worksharing-loop) construct with "
2172	"ORDERED clause with a parameter"_err_en_US);
2173	}
2174	}
2175
2176	void OmpStructureChecker::CheckOrderedDependClause(
2177	std::optional<int64_t> orderedValue) {
2178	auto visitDoacross{[&](const parser::OmpDoacross &doa,
2179	const parser::CharBlock &src) {
2180	if (auto *sinkVector{std::get_if<parser::OmpDoacross::Sink>(&doa.u)}) {
2181	int64_t numVar = sinkVector->v.v.size();
2182	if (orderedValue != numVar) {
2183	context_.Say(src,
2184	"The number of variables in the SINK iteration vector does not match the parameter specified in ORDERED clause"_err_en_US);
2185	}
2186	}
2187	}};
2188	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
2189	auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
2190	if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
2191	visitDoacross(*doAcross, clause->source);
2192	}
2193	}
2194	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
2195	auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
2196	visitDoacross(doaClause.v.v, clause->source);
2197	}
2198	}
2199
2200	void OmpStructureChecker::CheckTargetUpdate() {
2201	const parser::OmpClause *toWrapper{FindClause(llvm::omp::Clause::OMPC_to)};
2202	const parser::OmpClause *fromWrapper{
2203	FindClause(llvm::omp::Clause::OMPC_from)};
2204	if (!toWrapper && !fromWrapper) {
2205	context_.Say(GetContext().directiveSource,
2206	"At least one motion-clause (TO/FROM) must be specified on "
2207	"TARGET UPDATE construct."_err_en_US);
2208	}
2209	if (toWrapper && fromWrapper) {
2210	SymbolSourceMap toSymbols, fromSymbols;
2211	auto &fromClause{std::get<parser::OmpClause::From>(fromWrapper->u).v};
2212	auto &toClause{std::get<parser::OmpClause::To>(toWrapper->u).v};
2213	GetSymbolsInObjectList(
2214	std::get<parser::OmpObjectList>(fromClause.t), fromSymbols);
2215	GetSymbolsInObjectList(
2216	std::get<parser::OmpObjectList>(toClause.t), toSymbols);
2217
2218	for (auto &[symbol, source] : toSymbols) {
2219	auto fromSymbol{fromSymbols.find(symbol)};
2220	if (fromSymbol != fromSymbols.end()) {
2221	context_.Say(source,
2222	"A list item ('%s') can only appear in a TO or FROM clause, but not in both."_err_en_US,
2223	symbol->name());
2224	context_.Say(source, "'%s' appears in the TO clause."_because_en_US,
2225	symbol->name());
2226	context_.Say(fromSymbol->second,
2227	"'%s' appears in the FROM clause."_because_en_US,
2228	fromSymbol->first->name());
2229	}
2230	}
2231	}
2232	}
2233
2234	void OmpStructureChecker::CheckTaskDependenceType(
2235	const parser::OmpTaskDependenceType::Value &x) {
2236	// Common checks for task-dependence-type (DEPEND and UPDATE clauses).
2237	unsigned version{context_.langOptions().OpenMPVersion};
2238	unsigned since{0};
2239
2240	switch (x) {
2241	case parser::OmpTaskDependenceType::Value::In:
2242	case parser::OmpTaskDependenceType::Value::Out:
2243	case parser::OmpTaskDependenceType::Value::Inout:
2244	break;
2245	case parser::OmpTaskDependenceType::Value::Mutexinoutset:
2246	case parser::OmpTaskDependenceType::Value::Depobj:
2247	since = 50;
2248	break;
2249	case parser::OmpTaskDependenceType::Value::Inoutset:
2250	since = 52;
2251	break;
2252	}
2253
2254	if (version < since) {
2255	context_.Say(GetContext().clauseSource,
2256	"%s task dependence type is not supported in %s, %s"_warn_en_US,
2257	parser::ToUpperCaseLetters(
2258	parser::OmpTaskDependenceType::EnumToString(x)),
2259	ThisVersion(version), TryVersion(since));
2260	}
2261	}
2262
2263	void OmpStructureChecker::CheckDependenceType(
2264	const parser::OmpDependenceType::Value &x) {
2265	// Common checks for dependence-type (DEPEND and UPDATE clauses).
2266	unsigned version{context_.langOptions().OpenMPVersion};
2267	unsigned deprecatedIn{~0u};
2268
2269	switch (x) {
2270	case parser::OmpDependenceType::Value::Source:
2271	case parser::OmpDependenceType::Value::Sink:
2272	deprecatedIn = 52;
2273	break;
2274	}
2275
2276	if (version >= deprecatedIn) {
2277	context_.Say(GetContext().clauseSource,
2278	"%s dependence type is deprecated in %s"_warn_en_US,
2279	parser::ToUpperCaseLetters(parser::OmpDependenceType::EnumToString(x)),
2280	ThisVersion(deprecatedIn));
2281	}
2282	}
2283
2284	void OmpStructureChecker::Enter(
2285	const parser::OpenMPSimpleStandaloneConstruct &x) {
2286	const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};
2287	PushContextAndClauseSets(dir.source, dir.v);
2288	switch (dir.v) {
2289	case llvm::omp::Directive::OMPD_barrier:
2290	CheckBarrierNesting(x);
2291	break;
2292	case llvm::omp::Directive::OMPD_scan:
2293	CheckScan(x);
2294	break;
2295	default:
2296	break;
2297	}
2298	}
2299
2300	void OmpStructureChecker::Leave(
2301	const parser::OpenMPSimpleStandaloneConstruct &x) {
2302	switch (GetContext().directive) {
2303	case llvm::omp::Directive::OMPD_ordered:
2304	// [5.1] 2.19.9 Ordered Construct Restriction
2305	ChecksOnOrderedAsStandalone();
2306	break;
2307	case llvm::omp::Directive::OMPD_target_update:
2308	CheckTargetUpdate();
2309	break;
2310	default:
2311	break;
2312	}
2313	dirContext_.pop_back();
2314	}
2315
2316	void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
2317	const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2318	PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_flush);
2319	}
2320
2321	void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
2322	auto &flushList{std::get<std::optional<parser::OmpArgumentList>>(x.v.t)};
2323
2324	auto isVariableListItemOrCommonBlock{[this](const Symbol &sym) {
2325	return IsVariableListItem(sym) ||
2326	sym.detailsIf<semantics::CommonBlockDetails>();
2327	}};
2328
2329	if (flushList) {
2330	for (const parser::OmpArgument &arg : flushList->v) {
2331	if (auto *sym{GetArgumentSymbol(arg)};
2332	sym && !isVariableListItemOrCommonBlock(*sym)) {
2333	context_.Say(arg.source,
2334	"FLUSH argument must be a variable list item"_err_en_US);
2335	}
2336	}
2337
2338	if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
2339	FindClause(llvm::omp::Clause::OMPC_release) ||
2340	FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
2341	context_.Say(flushList->source,
2342	"If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items must not be specified on the FLUSH directive"_err_en_US);
2343	}
2344	}
2345
2346	unsigned version{context_.langOptions().OpenMPVersion};
2347	if (version >= 52) {
2348	using Flags = parser::OmpDirectiveSpecification::Flags;
2349	if (std::get<Flags>(x.v.t) == Flags::DeprecatedSyntax) {
2350	context_.Say(x.source,
2351	"The syntax \"FLUSH clause (object, ...)\" has been deprecated, use \"FLUSH(object, ...) clause\" instead"_warn_en_US);
2352	}
2353	}
2354
2355	dirContext_.pop_back();
2356	}
2357
2358	void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
2359	auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2360	auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
2361	PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_cancel);
2362
2363	if (auto maybeConstruct{GetCancelType(
2364	llvm::omp::Directive::OMPD_cancel, x.source, maybeClauses)}) {
2365	CheckCancellationNest(dirName.source, *maybeConstruct);
2366
2367	if (CurrentDirectiveIsNested()) {
2368	// nowait can be put on the end directive rather than the start directive
2369	// so we need to check both
2370	auto getParentClauses{[&]() {
2371	const DirectiveContext &parent{GetContextParent()};
2372	return llvm::concat<const llvm::omp::Clause>(
2373	parent.actualClauses, parent.endDirectiveClauses);
2374	}};
2375
2376	if (llvm::omp::nestedCancelDoAllowedSet.test(*maybeConstruct)) {
2377	for (llvm::omp::Clause clause : getParentClauses()) {
2378	if (clause == llvm::omp::Clause::OMPC_nowait) {
2379	context_.Say(dirName.source,
2380	"The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);
2381	}
2382	if (clause == llvm::omp::Clause::OMPC_ordered) {
2383	context_.Say(dirName.source,
2384	"The CANCEL construct cannot be nested inside of a worksharing construct with the ORDERED clause"_err_en_US);
2385	}
2386	}
2387	} else if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2388	*maybeConstruct)) {
2389	for (llvm::omp::Clause clause : getParentClauses()) {
2390	if (clause == llvm::omp::Clause::OMPC_nowait) {
2391	context_.Say(dirName.source,
2392	"The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);
2393	}
2394	}
2395	}
2396	}
2397	}
2398	}
2399
2400	void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
2401	dirContext_.pop_back();
2402	}
2403
2404	void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
2405	const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
2406	const auto &dirSource{std::get<parser::Verbatim>(dir.t).source};
2407	const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
2408	PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical);
2409	const auto &block{std::get<parser::Block>(x.t)};
2410	CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
2411	const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
2412	const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
2413	const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)};
2414	if (dirName && endDirName &&
2415	dirName->ToString().compare(endDirName->ToString())) {
2416	context_
2417	.Say(endDirName->source,
2418	parser::MessageFormattedText{
2419	"CRITICAL directive names do not match"_err_en_US})
2420	.Attach(dirName->source, "should be "_en_US);
2421	} else if (dirName && !endDirName) {
2422	context_
2423	.Say(dirName->source,
2424	parser::MessageFormattedText{
2425	"CRITICAL directive names do not match"_err_en_US})
2426	.Attach(dirName->source, "should be NULL"_en_US);
2427	} else if (!dirName && endDirName) {
2428	context_
2429	.Say(endDirName->source,
2430	parser::MessageFormattedText{
2431	"CRITICAL directive names do not match"_err_en_US})
2432	.Attach(endDirName->source, "should be NULL"_en_US);
2433	}
2434	if (!dirName && !ompClause.source.empty() &&
2435	ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") {
2436	context_.Say(dir.source,
2437	parser::MessageFormattedText{
2438	"Hint clause other than omp_sync_hint_none cannot be specified for "
2439	"an unnamed CRITICAL directive"_err_en_US});
2440	}
2441	}
2442
2443	void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
2444	dirContext_.pop_back();
2445	}
2446
2447	void OmpStructureChecker::Enter(
2448	const parser::OmpClause::CancellationConstructType &x) {
2449	llvm::omp::Directive dir{GetContext().directive};
2450	auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2451
2452	if (dir != llvm::omp::Directive::OMPD_cancel &&
2453	dir != llvm::omp::Directive::OMPD_cancellation_point) {
2454	// Do not call CheckAllowed/CheckAllowedClause, because in case of an error
2455	// it will print "CANCELLATION_CONSTRUCT_TYPE" as the clause name instead
2456	// of the contained construct name.
2457	context_.Say(dirName.source, "%s cannot follow %s"_err_en_US,
2458	parser::ToUpperCaseLetters(getDirectiveName(dirName.v)),
2459	parser::ToUpperCaseLetters(getDirectiveName(dir)));
2460	} else {
2461	switch (dirName.v) {
2462	case llvm::omp::Directive::OMPD_do:
2463	case llvm::omp::Directive::OMPD_parallel:
2464	case llvm::omp::Directive::OMPD_sections:
2465	case llvm::omp::Directive::OMPD_taskgroup:
2466	break;
2467	default:
2468	context_.Say(dirName.source,
2469	"%s is not a cancellable construct"_err_en_US,
2470	parser::ToUpperCaseLetters(getDirectiveName(dirName.v)));
2471	break;
2472	}
2473	}
2474	}
2475
2476	void OmpStructureChecker::Enter(
2477	const parser::OpenMPCancellationPointConstruct &x) {
2478	auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2479	auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
2480	PushContextAndClauseSets(
2481	dirName.source, llvm::omp::Directive::OMPD_cancellation_point);
2482
2483	if (auto maybeConstruct{
2484	GetCancelType(llvm::omp::Directive::OMPD_cancellation_point, x.source,
2485	maybeClauses)}) {
2486	CheckCancellationNest(dirName.source, *maybeConstruct);
2487	}
2488	}
2489
2490	void OmpStructureChecker::Leave(
2491	const parser::OpenMPCancellationPointConstruct &) {
2492	dirContext_.pop_back();
2493	}
2494
2495	std::optional<llvm::omp::Directive> OmpStructureChecker::GetCancelType(
2496	llvm::omp::Directive cancelDir, const parser::CharBlock &cancelSource,
2497	const std::optional<parser::OmpClauseList> &maybeClauses) {
2498	if (!maybeClauses) {
2499	return std::nullopt;
2500	}
2501	// Given clauses from CANCEL or CANCELLATION_POINT, identify the construct
2502	// to which the cancellation applies.
2503	std::optional<llvm::omp::Directive> cancelee;
2504	llvm::StringRef cancelName{getDirectiveName(cancelDir)};
2505
2506	for (const parser::OmpClause &clause : maybeClauses->v) {
2507	using CancellationConstructType =
2508	parser::OmpClause::CancellationConstructType;
2509	if (auto *cctype{std::get_if<CancellationConstructType>(&clause.u)}) {
2510	if (cancelee) {
2511	context_.Say(cancelSource,
2512	"Multiple cancel-directive-name clauses are not allowed on the %s construct"_err_en_US,
2513	parser::ToUpperCaseLetters(cancelName.str()));
2514	return std::nullopt;
2515	}
2516	cancelee = std::get<parser::OmpDirectiveName>(cctype->v.t).v;
2517	}
2518	}
2519
2520	if (!cancelee) {
2521	context_.Say(cancelSource,
2522	"Missing cancel-directive-name clause on the %s construct"_err_en_US,
2523	parser::ToUpperCaseLetters(cancelName.str()));
2524	return std::nullopt;
2525	}
2526
2527	return cancelee;
2528	}
2529
2530	void OmpStructureChecker::CheckCancellationNest(
2531	const parser::CharBlock &source, llvm::omp::Directive type) {
2532	llvm::StringRef typeName{getDirectiveName(type)};
2533
2534	if (CurrentDirectiveIsNested()) {
2535	// If construct-type-clause is taskgroup, the cancellation construct must be
2536	// closely nested inside a task or a taskloop construct and the cancellation
2537	// region must be closely nested inside a taskgroup region. If
2538	// construct-type-clause is sections, the cancellation construct must be
2539	// closely nested inside a sections or section construct. Otherwise, the
2540	// cancellation construct must be closely nested inside an OpenMP construct
2541	// that matches the type specified in construct-type-clause of the
2542	// cancellation construct.
2543	bool eligibleCancellation{false};
2544
2545	switch (type) {
2546	case llvm::omp::Directive::OMPD_taskgroup:
2547	if (llvm::omp::nestedCancelTaskgroupAllowedSet.test(
2548	GetContextParent().directive)) {
2549	eligibleCancellation = true;
2550	if (dirContext_.size() >= 3) {
2551	// Check if the cancellation region is closely nested inside a
2552	// taskgroup region when there are more than two levels of directives
2553	// in the directive context stack.
2554	if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
2555	FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
2556	for (int i = dirContext_.size() - 3; i >= 0; i--) {
2557	if (dirContext_[i].directive ==
2558	llvm::omp::Directive::OMPD_taskgroup) {
2559	break;
2560	}
2561	if (llvm::omp::nestedCancelParallelAllowedSet.test(
2562	dirContext_[i].directive)) {
2563	eligibleCancellation = false;
2564	break;
2565	}
2566	}
2567	}
2568	}
2569	}
2570	if (!eligibleCancellation) {
2571	context_.Say(source,
2572	"With %s clause, %s construct must be closely nested inside TASK or TASKLOOP construct and %s region must be closely nested inside TASKGROUP region"_err_en_US,
2573	parser::ToUpperCaseLetters(typeName.str()),
2574	ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
2575	}
2576	return;
2577	case llvm::omp::Directive::OMPD_sections:
2578	if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2579	GetContextParent().directive)) {
2580	eligibleCancellation = true;
2581	}
2582	break;
2583	case llvm::omp::Directive::OMPD_do:
2584	if (llvm::omp::nestedCancelDoAllowedSet.test(
2585	GetContextParent().directive)) {
2586	eligibleCancellation = true;
2587	}
2588	break;
2589	case llvm::omp::Directive::OMPD_parallel:
2590	if (llvm::omp::nestedCancelParallelAllowedSet.test(
2591	GetContextParent().directive)) {
2592	eligibleCancellation = true;
2593	}
2594	break;
2595	default:
2596	// This is diagnosed later.
2597	return;
2598	}
2599	if (!eligibleCancellation) {
2600	context_.Say(source,
2601	"With %s clause, %s construct cannot be closely nested inside %s construct"_err_en_US,
2602	parser::ToUpperCaseLetters(typeName.str()),
2603	ContextDirectiveAsFortran(),
2604	parser::ToUpperCaseLetters(
2605	getDirectiveName(GetContextParent().directive).str()));
2606	}
2607	} else {
2608	// The cancellation directive cannot be orphaned.
2609	switch (type) {
2610	case llvm::omp::Directive::OMPD_taskgroup:
2611	context_.Say(source,
2612	"%s %s directive is not closely nested inside TASK or TASKLOOP"_err_en_US,
2613	ContextDirectiveAsFortran(),
2614	parser::ToUpperCaseLetters(typeName.str()));
2615	break;
2616	case llvm::omp::Directive::OMPD_sections:
2617	context_.Say(source,
2618	"%s %s directive is not closely nested inside SECTION or SECTIONS"_err_en_US,
2619	ContextDirectiveAsFortran(),
2620	parser::ToUpperCaseLetters(typeName.str()));
2621	break;
2622	case llvm::omp::Directive::OMPD_do:
2623	context_.Say(source,
2624	"%s %s directive is not closely nested inside the construct that matches the DO clause type"_err_en_US,
2625	ContextDirectiveAsFortran(),
2626	parser::ToUpperCaseLetters(typeName.str()));
2627	break;
2628	case llvm::omp::Directive::OMPD_parallel:
2629	context_.Say(source,
2630	"%s %s directive is not closely nested inside the construct that matches the PARALLEL clause type"_err_en_US,
2631	ContextDirectiveAsFortran(),
2632	parser::ToUpperCaseLetters(typeName.str()));
2633	break;
2634	default:
2635	// This is diagnosed later.
2636	return;
2637	}
2638	}
2639	}
2640
2641	void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
2642	const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
2643	ResetPartialContext(dir.source);
2644	switch (dir.v) {
2645	case llvm::omp::Directive::OMPD_scope:
2646	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_scope);
2647	break;
2648	// 2.7.3 end-single-clause -> copyprivate-clause |
2649	// nowait-clause
2650	case llvm::omp::Directive::OMPD_single:
2651	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
2652	break;
2653	// 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
2654	case llvm::omp::Directive::OMPD_workshare:
2655	PushContextAndClauseSets(
2656	dir.source, llvm::omp::Directive::OMPD_end_workshare);
2657	break;
2658	default:
2659	// no clauses are allowed
2660	break;
2661	}
2662	}
2663
2664	// TODO: Verify the popping of dirContext requirement after nowait
2665	// implementation, as there is an implicit barrier at the end of the worksharing
2666	// constructs unless a nowait clause is specified. Only OMPD_end_single and
2667	// end_workshareare popped as they are pushed while entering the
2668	// EndBlockDirective.
2669	void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
2670	if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||
2671	(GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
2672	(GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
2673	dirContext_.pop_back();
2674	}
2675	}
2676
2677	/// parser::Block is a list of executable constructs, parser::BlockConstruct
2678	/// is Fortran's BLOCK/ENDBLOCK construct.
2679	/// Strip the outermost BlockConstructs, return the reference to the Block
2680	/// in the executable part of the innermost of the stripped constructs.
2681	/// Specifically, if the given `block` has a single entry (it's a list), and
2682	/// the entry is a BlockConstruct, get the Block contained within. Repeat
2683	/// this step as many times as possible.
2684	static const parser::Block &GetInnermostExecPart(const parser::Block &block) {
2685	const parser::Block *iter{&block};
2686	while (iter->size() == 1) {
2687	const parser::ExecutionPartConstruct &ep{iter->front()};
2688	if (auto *exec{std::get_if<parser::ExecutableConstruct>(&ep.u)}) {
2689	using BlockConstruct = common::Indirection<parser::BlockConstruct>;
2690	if (auto *bc{std::get_if<BlockConstruct>(&exec->u)}) {
2691	iter = &std::get<parser::Block>(bc->value().t);
2692	continue;
2693	}
2694	}
2695	break;
2696	}
2697	return *iter;
2698	}
2699
2700	// There is no consistent way to get the source of a given ActionStmt, so
2701	// extract the source information from Statement<ActionStmt> when we can,
2702	// and keep it around for error reporting in further analyses.
2703	struct SourcedActionStmt {
2704	const parser::ActionStmt *stmt{nullptr};
2705	parser::CharBlock source;
2706
2707	operator bool() const { return stmt != nullptr; }
2708	};
2709
2710	struct AnalyzedCondStmt {
2711	SomeExpr cond{evaluate::NullPointer{}}; // Default ctor is deleted
2712	parser::CharBlock source;
2713	SourcedActionStmt ift, iff;
2714	};
2715
2716	static SourcedActionStmt GetActionStmt(
2717	const parser::ExecutionPartConstruct *x) {
2718	if (x == nullptr) {
2719	return SourcedActionStmt{};
2720	}
2721	if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
2722	using ActionStmt = parser::Statement<parser::ActionStmt>;
2723	if (auto *stmt{std::get_if<ActionStmt>(&exec->u)}) {
2724	return SourcedActionStmt{&stmt->statement, stmt->source};
2725	}
2726	}
2727	return SourcedActionStmt{};
2728	}
2729
2730	static SourcedActionStmt GetActionStmt(const parser::Block &block) {
2731	if (block.size() == 1) {
2732	return GetActionStmt(&block.front());
2733	}
2734	return SourcedActionStmt{};
2735	}
2736
2737	// Compute the `evaluate::Assignment` from parser::ActionStmt. The assumption
2738	// is that the ActionStmt will be either an assignment or a pointer-assignment,
2739	// otherwise return std::nullopt.
2740	// Note: This function can return std::nullopt on [Pointer]AssignmentStmt where
2741	// the "typedAssignment" is unset. This can happen if there are semantic errors
2742	// in the purported assignment.
2743	static std::optional<evaluate::Assignment> GetEvaluateAssignment(
2744	const parser::ActionStmt *x) {
2745	if (x == nullptr) {
2746	return std::nullopt;
2747	}
2748
2749	using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
2750	using PointerAssignmentStmt =
2751	common::Indirection<parser::PointerAssignmentStmt>;
2752	using TypedAssignment = parser::AssignmentStmt::TypedAssignment;
2753
2754	return common::visit(
2755	[](auto &&s) -> std::optional<evaluate::Assignment> {
2756	using BareS = llvm::remove_cvref_t<decltype(s)>;
2757	if constexpr (std::is_same_v<BareS, AssignmentStmt> ||
2758	std::is_same_v<BareS, PointerAssignmentStmt>) {
2759	const TypedAssignment &typed{s.value().typedAssignment};
2760	// ForwardOwningPointer typedAssignment
2761	// `- GenericAssignmentWrapper ^.get()
2762	// `- std::optional<Assignment> ^->v
2763	return typed.get()->v;
2764	} else {
2765	return std::nullopt;
2766	}
2767	},
2768	x->u);
2769	}
2770
2771	// Check if the ActionStmt is actually a [Pointer]AssignmentStmt. This is
2772	// to separate cases where the source has something that looks like an
2773	// assignment, but is semantically wrong (diagnosed by general semantic
2774	// checks), and where the source has some other statement (which we want
2775	// to report as "should be an assignment").
2776	static bool IsAssignment(const parser::ActionStmt *x) {
2777	if (x == nullptr) {
2778	return false;
2779	}
2780
2781	using AssignmentStmt = common::Indirection<parser::AssignmentStmt>;
2782	using PointerAssignmentStmt =
2783	common::Indirection<parser::PointerAssignmentStmt>;
2784
2785	return common::visit(
2786	[](auto &&s) -> bool {
2787	using BareS = llvm::remove_cvref_t<decltype(s)>;
2788	return std::is_same_v<BareS, AssignmentStmt> ||
2789	std::is_same_v<BareS, PointerAssignmentStmt>;
2790	},
2791	x->u);
2792	}
2793
2794	static std::optional<AnalyzedCondStmt> AnalyzeConditionalStmt(
2795	const parser::ExecutionPartConstruct *x) {
2796	if (x == nullptr) {
2797	return std::nullopt;
2798	}
2799
2800	// Extract the evaluate::Expr from ScalarLogicalExpr.
2801	auto getFromLogical{[](const parser::ScalarLogicalExpr &logical) {
2802	// ScalarLogicalExpr is Scalar<Logical<common::Indirection<Expr>>>
2803	const parser::Expr &expr{logical.thing.thing.value()};
2804	return GetEvaluateExpr(expr);
2805	}};
2806
2807	// Recognize either
2808	// ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> IfStmt, or
2809	// ExecutionPartConstruct -> ExecutableConstruct -> IfConstruct.
2810
2811	if (auto &&action{GetActionStmt(x)}) {
2812	if (auto *ifs{std::get_if<common::Indirection<parser::IfStmt>>(
2813	&action.stmt->u)}) {
2814	const parser::IfStmt &s{ifs->value()};
2815	auto &&maybeCond{
2816	getFromLogical(std::get<parser::ScalarLogicalExpr>(s.t))};
2817	auto &thenStmt{
2818	std::get<parser::UnlabeledStatement<parser::ActionStmt>>(s.t)};
2819	if (maybeCond) {
2820	return AnalyzedCondStmt{std::move(*maybeCond), action.source,
2821	SourcedActionStmt{&thenStmt.statement, thenStmt.source},
2822	SourcedActionStmt{}};
2823	}
2824	}
2825	return std::nullopt;
2826	}
2827
2828	if (auto *exec{std::get_if<parser::ExecutableConstruct>(&x->u)}) {
2829	if (auto *ifc{
2830	std::get_if<common::Indirection<parser::IfConstruct>>(&exec->u)}) {
2831	using ElseBlock = parser::IfConstruct::ElseBlock;
2832	using ElseIfBlock = parser::IfConstruct::ElseIfBlock;
2833	const parser::IfConstruct &s{ifc->value()};
2834
2835	if (!std::get<std::list<ElseIfBlock>>(s.t).empty()) {
2836	// Not expecting any else-if statements.
2837	return std::nullopt;
2838	}
2839	auto &stmt{std::get<parser::Statement<parser::IfThenStmt>>(s.t)};
2840	auto &&maybeCond{getFromLogical(
2841	std::get<parser::ScalarLogicalExpr>(stmt.statement.t))};
2842	if (!maybeCond) {
2843	return std::nullopt;
2844	}
2845
2846	if (auto &maybeElse{std::get<std::optional<ElseBlock>>(s.t)}) {
2847	AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
2848	GetActionStmt(std::get<parser::Block>(s.t)),
2849	GetActionStmt(std::get<parser::Block>(maybeElse->t))};
2850	if (result.ift.stmt && result.iff.stmt) {
2851	return result;
2852	}
2853	} else {
2854	AnalyzedCondStmt result{std::move(*maybeCond), stmt.source,
2855	GetActionStmt(std::get<parser::Block>(s.t)), SourcedActionStmt{}};
2856	if (result.ift.stmt) {
2857	return result;
2858	}
2859	}
2860	}
2861	return std::nullopt;
2862	}
2863
2864	return std::nullopt;
2865	}
2866
2867	static std::pair<parser::CharBlock, parser::CharBlock> SplitAssignmentSource(
2868	parser::CharBlock source) {
2869	// Find => in the range, if not found, find = that is not a part of
2870	// <=, >=, ==, or /=.
2871	auto trim{[](std::string_view v) {
2872	const char *begin{v.data()};
2873	const char *end{begin + v.size()};
2874	while (*begin == ' ' && begin != end) {
2875	++begin;
2876	}
2877	while (begin != end && end[-1] == ' ') {
2878	--end;
2879	}
2880	assert(begin != end && "Source should not be empty");
2881	return parser::CharBlock(begin, end - begin);
2882	}};
2883
2884	std::string_view sv(source.begin(), source.size());
2885
2886	if (auto where{sv.find(str: "=>")}; where != sv.npos) {
2887	std::string_view lhs(sv.data(), where);
2888	std::string_view rhs(sv.data() + where + 2, sv.size() - where - 2);
2889	return std::make_pair(trim(lhs), trim(rhs));
2890	}
2891
2892	// Go backwards, since all the exclusions above end with a '='.
2893	for (size_t next{source.size()}; next > 1; --next) {
2894	if (sv[next - 1] == '=' && !llvm::is_contained(Range: "<>=/", Element: sv[next - 2])) {
2895	std::string_view lhs(sv.data(), next - 1);
2896	std::string_view rhs(sv.data() + next, sv.size() - next);
2897	return std::make_pair(trim(lhs), trim(rhs));
2898	}
2899	}
2900	llvm_unreachable("Could not find assignment operator");
2901	}
2902
2903	namespace atomic {
2904
2905	struct DesignatorCollector : public evaluate::Traverse<DesignatorCollector,
2906	std::vector<SomeExpr>, false> {
2907	using Result = std::vector<SomeExpr>;
2908	using Base = evaluate::Traverse<DesignatorCollector, Result, false>;
2909	DesignatorCollector() : Base(*this) {}
2910
2911	Result Default() const { return {}; }
2912
2913	using Base::operator();
2914
2915	template <typename T> //
2916	Result operator()(const evaluate::Designator<T> &x) const {
2917	// Once in a designator, don't traverse it any further (i.e. only
2918	// collect top-level designators).
2919	auto copy{x};
2920	return Result{AsGenericExpr(std::move(copy))};
2921	}
2922
2923	template <typename... Rs> //
2924	Result Combine(Result &&result, Rs &&...results) const {
2925	Result v(std::move(result));
2926	auto moveAppend{[](auto &accum, auto &&other) {
2927	for (auto &&s : other) {
2928	accum.push_back(std::move(s));
2929	}
2930	}};
2931	(moveAppend(v, std::move(results)), ...);
2932	return v;
2933	}
2934	};
2935
2936	struct VariableFinder : public evaluate::AnyTraverse<VariableFinder> {
2937	using Base = evaluate::AnyTraverse<VariableFinder>;
2938	VariableFinder(const SomeExpr &v) : Base(*this), var(v) {}
2939
2940	using Base::operator();
2941
2942	template <typename T>
2943	bool operator()(const evaluate::Designator<T> &x) const {
2944	auto copy{x};
2945	return evaluate::AsGenericExpr(std::move(copy)) == var;
2946	}
2947
2948	template <typename T>
2949	bool operator()(const evaluate::FunctionRef<T> &x) const {
2950	auto copy{x};
2951	return evaluate::AsGenericExpr(std::move(copy)) == var;
2952	}
2953
2954	private:
2955	const SomeExpr &var;
2956	};
2957	} // namespace atomic
2958
2959	static bool IsPointerAssignment(const evaluate::Assignment &x) {
2960	return std::holds_alternative<evaluate::Assignment::BoundsSpec>(x.u) ||
2961	std::holds_alternative<evaluate::Assignment::BoundsRemapping>(x.u);
2962	}
2963
2964	static bool IsCheckForAssociated(const SomeExpr &cond) {
2965	return GetTopLevelOperation(cond).first == operation::Operator::Associated;
2966	}
2967
2968	static bool HasCommonDesignatorSymbols(
2969	const evaluate::SymbolVector &baseSyms, const SomeExpr &other) {
2970	// Compare the designators used in "other" with the designators whose
2971	// symbols are given in baseSyms.
2972	// This is a part of the check if these two expressions can access the same
2973	// storage: if the designators used in them are different enough, then they
2974	// will be assumed not to access the same memory.
2975	//
2976	// Consider an (array element) expression x%y(w%z), the corresponding symbol
2977	// vector will be {x, y, w, z} (i.e. the symbols for these names).
2978	// Check whether this exact sequence appears anywhere in any the symbol
2979	// vector for "other". This will be true for x(y) and x(y+1), so this is
2980	// not a sufficient condition, but can be used to eliminate candidates
2981	// before doing more exhaustive checks.
2982	//
2983	// If any of the symbols in this sequence are function names, assume that
2984	// there is no storage overlap, mostly because it would be impossible in
2985	// general to determine what storage the function will access.
2986	// Note: if f is pure, then two calls to f will access the same storage
2987	// when called with the same arguments. This check is not done yet.
2988
2989	if (llvm::any_of(
2990	baseSyms, [](const SymbolRef &s) { return s->IsSubprogram(); })) {
2991	// If there is a function symbol in the chain then we can't infer much
2992	// about the accessed storage.
2993	return false;
2994	}
2995
2996	auto isSubsequence{// Is u a subsequence of v.
2997	[](const evaluate::SymbolVector &u, const evaluate::SymbolVector &v) {
2998	size_t us{u.size()}, vs{v.size()};
2999	if (us > vs) {
3000	return false;
3001	}
3002	for (size_t off{0}; off != vs - us + 1; ++off) {
3003	bool same{true};
3004	for (size_t i{0}; i != us; ++i) {
3005	if (u[i] != v[off + i]) {
3006	same = false;
3007	break;
3008	}
3009	}
3010	if (same) {
3011	return true;
3012	}
3013	}
3014	return false;
3015	}};
3016
3017	evaluate::SymbolVector otherSyms{evaluate::GetSymbolVector(other)};
3018	return isSubsequence(baseSyms, otherSyms);
3019	}
3020
3021	static bool HasCommonTopLevelDesignators(
3022	const std::vector<SomeExpr> &baseDsgs, const SomeExpr &other) {
3023	// Compare designators directly as expressions. This will ensure
3024	// that x(y) and x(y+1) are not flagged as overlapping, whereas
3025	// the symbol vectors for both of these would be identical.
3026	std::vector<SomeExpr> otherDsgs{atomic::DesignatorCollector{}(other)};
3027
3028	for (auto &s : baseDsgs) {
3029	if (llvm::any_of(otherDsgs, [&](auto &&t) { return s == t; })) {
3030	return true;
3031	}
3032	}
3033	return false;
3034	}
3035
3036	static const SomeExpr *HasStorageOverlap(
3037	const SomeExpr &base, llvm::ArrayRef<SomeExpr> exprs) {
3038	evaluate::SymbolVector baseSyms{evaluate::GetSymbolVector(base)};
3039	std::vector<SomeExpr> baseDsgs{atomic::DesignatorCollector{}(base)};
3040
3041	for (const SomeExpr &expr : exprs) {
3042	if (!HasCommonDesignatorSymbols(baseSyms, expr)) {
3043	continue;
3044	}
3045	if (HasCommonTopLevelDesignators(baseDsgs, expr)) {
3046	return &expr;
3047	}
3048	}
3049	return nullptr;
3050	}
3051
3052	static bool IsMaybeAtomicWrite(const evaluate::Assignment &assign) {
3053	// This ignores function calls, so it will accept "f(x) = f(x) + 1"
3054	// for example.
3055	return HasStorageOverlap(assign.lhs, assign.rhs) == nullptr;
3056	}
3057
3058	static bool IsSubexpressionOf(const SomeExpr &sub, const SomeExpr &super) {
3059	return atomic::VariableFinder{sub}(super);
3060	}
3061
3062	static void SetExpr(parser::TypedExpr &expr, MaybeExpr value) {
3063	if (value) {
3064	expr.Reset(new evaluate::GenericExprWrapper(std::move(value)),
3065	evaluate::GenericExprWrapper::Deleter);
3066	}
3067	}
3068
3069	static void SetAssignment(parser::AssignmentStmt::TypedAssignment &assign,
3070	std::optional<evaluate::Assignment> value) {
3071	if (value) {
3072	assign.Reset(new evaluate::GenericAssignmentWrapper(std::move(value)),
3073	evaluate::GenericAssignmentWrapper::Deleter);
3074	}
3075	}
3076
3077	static parser::OpenMPAtomicConstruct::Analysis::Op MakeAtomicAnalysisOp(
3078	int what,
3079	const std::optional<evaluate::Assignment> &maybeAssign = std::nullopt) {
3080	parser::OpenMPAtomicConstruct::Analysis::Op operation;
3081	operation.what = what;
3082	SetAssignment(operation.assign, maybeAssign);
3083	return operation;
3084	}
3085
3086	static parser::OpenMPAtomicConstruct::Analysis MakeAtomicAnalysis(
3087	const SomeExpr &atom, const MaybeExpr &cond,
3088	parser::OpenMPAtomicConstruct::Analysis::Op &&op0,
3089	parser::OpenMPAtomicConstruct::Analysis::Op &&op1) {
3090	// Defined in flang/include/flang/Parser/parse-tree.h
3091	//
3092	// struct Analysis {
3093	// struct Kind {
3094	// static constexpr int None = 0;
3095	// static constexpr int Read = 1;
3096	// static constexpr int Write = 2;
3097	// static constexpr int Update = Read | Write;
3098	// static constexpr int Action = 3; // Bits containing N, R, W, U
3099	// static constexpr int IfTrue = 4;
3100	// static constexpr int IfFalse = 8;
3101	// static constexpr int Condition = 12; // Bits containing IfTrue, IfFalse
3102	// };
3103	// struct Op {
3104	// int what;
3105	// TypedAssignment assign;
3106	// };
3107	// TypedExpr atom, cond;
3108	// Op op0, op1;
3109	// };
3110
3111	parser::OpenMPAtomicConstruct::Analysis an;
3112	SetExpr(an.atom, atom);
3113	SetExpr(an.cond, cond);
3114	an.op0 = std::move(op0);
3115	an.op1 = std::move(op1);
3116	return an;
3117	}
3118
3119	void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
3120	llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
3121	parser::CharBlock source) {
3122	if (auto *expr{HasStorageOverlap(base, exprs)}) {
3123	context_.Say(source,
3124	"Within atomic operation %s and %s access the same storage"_warn_en_US,
3125	base.AsFortran(), expr->AsFortran());
3126	}
3127	}
3128
3129	void OmpStructureChecker::ErrorShouldBeVariable(
3130	const MaybeExpr &expr, parser::CharBlock source) {
3131	if (expr) {
3132	context_.Say(source, "Atomic expression %s should be a variable"_err_en_US,
3133	expr->AsFortran());
3134	} else {
3135	context_.Say(source, "Atomic expression should be a variable"_err_en_US);
3136	}
3137	}
3138
3139	/// Check if `expr` satisfies the following conditions for x and v:
3140	///
3141	/// [6.0:189:10-12]
3142	/// - x and v (as applicable) are either scalar variables or
3143	/// function references with scalar data pointer result of non-character
3144	/// intrinsic type or variables that are non-polymorphic scalar pointers
3145	/// and any length type parameter must be constant.
3146	void OmpStructureChecker::CheckAtomicType(
3147	SymbolRef sym, parser::CharBlock source, std::string_view name) {
3148	const DeclTypeSpec *typeSpec{sym->GetType()};
3149	if (!typeSpec) {
3150	return;
3151	}
3152
3153	if (!IsPointer(sym)) {
3154	using Category = DeclTypeSpec::Category;
3155	Category cat{typeSpec->category()};
3156	if (cat == Category::Character) {
3157	context_.Say(source,
3158	"Atomic variable %s cannot have CHARACTER type"_err_en_US, name);
3159	} else if (cat != Category::Numeric && cat != Category::Logical) {
3160	context_.Say(source,
3161	"Atomic variable %s should have an intrinsic type"_err_en_US, name);
3162	}
3163	return;
3164	}
3165
3166	// Variable is a pointer.
3167	if (typeSpec->IsPolymorphic()) {
3168	context_.Say(source,
3169	"Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,
3170	name);
3171	return;
3172	}
3173
3174	// Go over all length parameters, if any, and check if they are
3175	// explicit.
3176	if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
3177	if (llvm::any_of(derived->parameters(), [](auto &&entry) {
3178	// "entry" is a map entry
3179	return entry.second.isLen() && !entry.second.isExplicit();
3180	})) {
3181	context_.Say(source,
3182	"Atomic variable %s is a pointer to a type with non-constant length parameter"_err_en_US,
3183	name);
3184	}
3185	}
3186	}
3187
3188	void OmpStructureChecker::CheckAtomicVariable(
3189	const SomeExpr &atom, parser::CharBlock source) {
3190	if (atom.Rank() != 0) {
3191	context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
3192	atom.AsFortran());
3193	}
3194
3195	std::vector<SomeExpr> dsgs{atomic::DesignatorCollector{}(atom)};
3196	assert(dsgs.size() == 1 && "Should have a single top-level designator");
3197	evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
3198
3199	CheckAtomicType(syms.back(), source, atom.AsFortran());
3200
3201	if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
3202	context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
3203	atom.AsFortran());
3204	}
3205	}
3206
3207	std::pair<const parser::ExecutionPartConstruct *,
3208	const parser::ExecutionPartConstruct *>
3209	OmpStructureChecker::CheckUpdateCapture(
3210	const parser::ExecutionPartConstruct *ec1,
3211	const parser::ExecutionPartConstruct *ec2, parser::CharBlock source) {
3212	// Decide which statement is the atomic update and which is the capture.
3213	//
3214	// The two allowed cases are:
3215	// x = ... atomic-var = ...
3216	// ... = x capture-var = atomic-var (with optional converts)
3217	// or
3218	// ... = x capture-var = atomic-var (with optional converts)
3219	// x = ... atomic-var = ...
3220	//
3221	// The case of 'a = b; b = a' is ambiguous, so pick the first one as capture
3222	// (which makes more sense, as it captures the original value of the atomic
3223	// variable).
3224	//
3225	// If the two statements don't fit these criteria, return a pair of default-
3226	// constructed values.
3227	using ReturnTy = std::pair<const parser::ExecutionPartConstruct *,
3228	const parser::ExecutionPartConstruct *>;
3229
3230	SourcedActionStmt act1{GetActionStmt(ec1)};
3231	SourcedActionStmt act2{GetActionStmt(ec2)};
3232	auto maybeAssign1{GetEvaluateAssignment(act1.stmt)};
3233	auto maybeAssign2{GetEvaluateAssignment(act2.stmt)};
3234	if (!maybeAssign1 || !maybeAssign2) {
3235	if (!IsAssignment(act1.stmt) || !IsAssignment(act2.stmt)) {
3236	context_.Say(source,
3237	"ATOMIC UPDATE operation with CAPTURE should contain two assignments"_err_en_US);
3238	}
3239	return std::make_pair(x: nullptr, y: nullptr);
3240	}
3241
3242	auto as1{*maybeAssign1}, as2{*maybeAssign2};
3243
3244	auto isUpdateCapture{
3245	[](const evaluate::Assignment &u, const evaluate::Assignment &c) {
3246	return IsSameOrConvertOf(c.rhs, u.lhs);
3247	}};
3248
3249	// Do some checks that narrow down the possible choices for the update
3250	// and the capture statements. This will help to emit better diagnostics.
3251	// 1. An assignment could be an update (cbu) if the left-hand side is a
3252	// subexpression of the right-hand side.
3253	// 2. An assignment could be a capture (cbc) if the right-hand side is
3254	// a variable (or a function ref), with potential type conversions.
3255	bool cbu1{IsSubexpressionOf(as1.lhs, as1.rhs)}; // Can as1 be an update?
3256	bool cbu2{IsSubexpressionOf(as2.lhs, as2.rhs)}; // Can as2 be an update?
3257	bool cbc1{IsVarOrFunctionRef(GetConvertInput(as1.rhs))}; // Can 1 be capture?
3258	bool cbc2{IsVarOrFunctionRef(GetConvertInput(as2.rhs))}; // Can 2 be capture?
3259
3260	// We want to diagnose cases where both assignments cannot be an update,
3261	// or both cannot be a capture, as well as cases where either assignment
3262	// cannot be any of these two.
3263	//
3264	// If we organize these boolean values into a matrix
3265	// |cbu1 cbu2|
3266	// |cbc1 cbc2|
3267	// then we want to diagnose cases where the matrix has a zero (i.e. "false")
3268	// row or column, including the case where everything is zero. All these
3269	// cases correspond to the determinant of the matrix being 0, which suggests
3270	// that checking the det may be a convenient diagnostic check. There is only
3271	// one additional case where the det is 0, which is when the matrix is all 1
3272	// ("true"). The "all true" case represents the situation where both
3273	// assignments could be an update as well as a capture. On the other hand,
3274	// whenever det != 0, the roles of the update and the capture can be
3275	// unambiguously assigned to as1 and as2 [1].
3276	//
3277	// [1] This can be easily verified by hand: there are 10 2x2 matrices with
3278	// det = 0, leaving 6 cases where det != 0:
3279	// 0 1 0 1 1 0 1 0 1 1 1 1
3280	// 1 0 1 1 0 1 1 1 0 1 1 0
3281	// In each case the classification is unambiguous.
3282
3283	// |cbu1 cbu2|
3284	// det |cbc1 cbc2| = cbu1*cbc2 - cbu2*cbc1
3285	int det{int(cbu1) * int(cbc2) - int(cbu2) * int(cbc1)};
3286
3287	auto errorCaptureShouldRead{[&](const parser::CharBlock &source,
3288	const std::string &expr) {
3289	context_.Say(source,
3290	"In ATOMIC UPDATE operation with CAPTURE the right-hand side of the capture assignment should read %s"_err_en_US,
3291	expr);
3292	}};
3293
3294	auto errorNeitherWorks{[&]() {
3295	context_.Say(source,
3296	"In ATOMIC UPDATE operation with CAPTURE neither statement could be the update or the capture"_err_en_US);
3297	}};
3298
3299	auto makeSelectionFromDet{[&](int det) -> ReturnTy {
3300	// If det != 0, then the checks unambiguously suggest a specific
3301	// categorization.
3302	// If det == 0, then this function should be called only if the
3303	// checks haven't ruled out any possibility, i.e. when both assigments
3304	// could still be either updates or captures.
3305	if (det > 0) {
3306	// as1 is update, as2 is capture
3307	if (isUpdateCapture(as1, as2)) {
3308	return std::make_pair(/*Update=*/ec1, /*Capture=*/ec2);
3309	} else {
3310	errorCaptureShouldRead(act2.source, as1.lhs.AsFortran());
3311	return std::make_pair(nullptr, nullptr);
3312	}
3313	} else if (det < 0) {
3314	// as2 is update, as1 is capture
3315	if (isUpdateCapture(as2, as1)) {
3316	return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
3317	} else {
3318	errorCaptureShouldRead(act1.source, as2.lhs.AsFortran());
3319	return std::make_pair(nullptr, nullptr);
3320	}
3321	} else {
3322	bool updateFirst{isUpdateCapture(as1, as2)};
3323	bool captureFirst{isUpdateCapture(as2, as1)};
3324	if (updateFirst && captureFirst) {
3325	// If both assignment could be the update and both could be the
3326	// capture, emit a warning about the ambiguity.
3327	context_.Say(act1.source,
3328	"In ATOMIC UPDATE operation with CAPTURE either statement could be the update and the capture, assuming the first one is the capture statement"_warn_en_US);
3329	return std::make_pair(/*Update=*/ec2, /*Capture=*/ec1);
3330	}
3331	if (updateFirst != captureFirst) {
3332	const parser::ExecutionPartConstruct *upd{updateFirst ? ec1 : ec2};
3333	const parser::ExecutionPartConstruct *cap{captureFirst ? ec1 : ec2};
3334	return std::make_pair(upd, cap);
3335	}
3336	assert(!updateFirst && !captureFirst);
3337	errorNeitherWorks();
3338	return std::make_pair(nullptr, nullptr);
3339	}
3340	}};
3341
3342	if (det != 0 || (cbu1 && cbu2 && cbc1 && cbc2)) {
3343	return makeSelectionFromDet(det);
3344	}
3345	assert(det == 0 && "Prior checks should have covered det != 0");
3346
3347	// If neither of the statements is an RMW update, it could still be a
3348	// "write" update. Pretty much any assignment can be a write update, so
3349	// recompute det with cbu1 = cbu2 = true.
3350	if (int writeDet{int(cbc2) - int(cbc1)}; writeDet || (cbc1 && cbc2)) {
3351	return makeSelectionFromDet(writeDet);
3352	}
3353
3354	// It's only errors from here on.
3355
3356	if (!cbu1 && !cbu2 && !cbc1 && !cbc2) {
3357	errorNeitherWorks();
3358	return std::make_pair(x: nullptr, y: nullptr);
3359	}
3360
3361	// The remaining cases are that
3362	// - no candidate for update, or for capture,
3363	// - one of the assigments cannot be anything.
3364
3365	if (!cbu1 && !cbu2) {
3366	context_.Say(source,
3367	"In ATOMIC UPDATE operation with CAPTURE neither statement could be the update"_err_en_US);
3368	return std::make_pair(x: nullptr, y: nullptr);
3369	} else if (!cbc1 && !cbc2) {
3370	context_.Say(source,
3371	"In ATOMIC UPDATE operation with CAPTURE neither statement could be the capture"_err_en_US);
3372	return std::make_pair(x: nullptr, y: nullptr);
3373	}
3374
3375	if ((!cbu1 && !cbc1) || (!cbu2 && !cbc2)) {
3376	auto &src = (!cbu1 && !cbc1) ? act1.source : act2.source;
3377	context_.Say(src,
3378	"In ATOMIC UPDATE operation with CAPTURE the statement could be neither the update nor the capture"_err_en_US);
3379	return std::make_pair(x: nullptr, y: nullptr);
3380	}
3381
3382	// All cases should have been covered.
3383	llvm_unreachable("Unchecked condition");
3384	}
3385
3386	void OmpStructureChecker::CheckAtomicCaptureAssignment(
3387	const evaluate::Assignment &capture, const SomeExpr &atom,
3388	parser::CharBlock source) {
3389	auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3390	const SomeExpr &cap{capture.lhs};
3391
3392	if (!IsVarOrFunctionRef(atom)) {
3393	ErrorShouldBeVariable(atom, rsrc);
3394	} else {
3395	CheckAtomicVariable(atom, rsrc);
3396	// This part should have been checked prior to calling this function.
3397	assert(*GetConvertInput(capture.rhs) == atom &&
3398	"This cannot be a capture assignment");
3399	CheckStorageOverlap(atom, {cap}, source);
3400	}
3401	}
3402
3403	void OmpStructureChecker::CheckAtomicReadAssignment(
3404	const evaluate::Assignment &read, parser::CharBlock source) {
3405	auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3406
3407	if (auto maybe{GetConvertInput(read.rhs)}) {
3408	const SomeExpr &atom{*maybe};
3409
3410	if (!IsVarOrFunctionRef(atom)) {
3411	ErrorShouldBeVariable(atom, rsrc);
3412	} else {
3413	CheckAtomicVariable(atom, rsrc);
3414	CheckStorageOverlap(atom, {read.lhs}, source);
3415	}
3416	} else {
3417	ErrorShouldBeVariable(read.rhs, rsrc);
3418	}
3419	}
3420
3421	void OmpStructureChecker::CheckAtomicWriteAssignment(
3422	const evaluate::Assignment &write, parser::CharBlock source) {
3423	// [6.0:190:13-15]
3424	// A write structured block is write-statement, a write statement that has
3425	// one of the following forms:
3426	// x = expr
3427	// x => expr
3428	auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3429	const SomeExpr &atom{write.lhs};
3430
3431	if (!IsVarOrFunctionRef(atom)) {
3432	ErrorShouldBeVariable(atom, rsrc);
3433	} else {
3434	CheckAtomicVariable(atom, lsrc);
3435	CheckStorageOverlap(atom, {write.rhs}, source);
3436	}
3437	}
3438
3439	void OmpStructureChecker::CheckAtomicUpdateAssignment(
3440	const evaluate::Assignment &update, parser::CharBlock source) {
3441	// [6.0:191:1-7]
3442	// An update structured block is update-statement, an update statement
3443	// that has one of the following forms:
3444	// x = x operator expr
3445	// x = expr operator x
3446	// x = intrinsic-procedure-name (x)
3447	// x = intrinsic-procedure-name (x, expr-list)
3448	// x = intrinsic-procedure-name (expr-list, x)
3449	auto [lsrc, rsrc]{SplitAssignmentSource(source)};
3450	const SomeExpr &atom{update.lhs};
3451
3452	if (!IsVarOrFunctionRef(atom)) {
3453	ErrorShouldBeVariable(atom, rsrc);
3454	// Skip other checks.
3455	return;
3456	}
3457
3458	CheckAtomicVariable(atom, lsrc);
3459
3460	std::pair<operation::Operator, std::vector<SomeExpr>> top{
3461	operation::Operator::Unknown, {}};
3462	if (auto &&maybeInput{GetConvertInput(update.rhs)}) {
3463	top = GetTopLevelOperation(*maybeInput);
3464	}
3465	switch (top.first) {
3466	case operation::Operator::Add:
3467	case operation::Operator::Sub:
3468	case operation::Operator::Mul:
3469	case operation::Operator::Div:
3470	case operation::Operator::And:
3471	case operation::Operator::Or:
3472	case operation::Operator::Eqv:
3473	case operation::Operator::Neqv:
3474	case operation::Operator::Min:
3475	case operation::Operator::Max:
3476	case operation::Operator::Identity:
3477	break;
3478	case operation::Operator::Call:
3479	context_.Say(source,
3480	"A call to this function is not a valid ATOMIC UPDATE operation"_err_en_US);
3481	return;
3482	case operation::Operator::Convert:
3483	context_.Say(source,
3484	"An implicit or explicit type conversion is not a valid ATOMIC UPDATE operation"_err_en_US);
3485	return;
3486	case operation::Operator::Intrinsic:
3487	context_.Say(source,
3488	"This intrinsic function is not a valid ATOMIC UPDATE operation"_err_en_US);
3489	return;
3490	case operation::Operator::Constant:
3491	case operation::Operator::Unknown:
3492	context_.Say(
3493	source, "This is not a valid ATOMIC UPDATE operation"_err_en_US);
3494	return;
3495	default:
3496	assert(
3497	top.first != operation::Operator::Identity && "Handle this separately");
3498	context_.Say(source,
3499	"The %s operator is not a valid ATOMIC UPDATE operation"_err_en_US,
3500	operation::ToString(top.first));
3501	return;
3502	}
3503	// Check if `atom` occurs exactly once in the argument list.
3504	std::vector<SomeExpr> nonAtom;
3505	auto unique{[&]() { // -> iterator
3506	auto found{top.second.end()};
3507	for (auto i{top.second.begin()}, e{top.second.end()}; i != e; ++i) {
3508	if (IsSameOrConvertOf(*i, atom)) {
3509	if (found != top.second.end()) {
3510	return top.second.end();
3511	}
3512	found = i;
3513	} else {
3514	nonAtom.push_back(*i);
3515	}
3516	}
3517	return found;
3518	}()};
3519
3520	if (unique == top.second.end()) {
3521	if (top.first == operation::Operator::Identity) {
3522	// This is "x = y".
3523	context_.Say(rsrc,
3524	"The atomic variable %s should appear as an argument in the update operation"_err_en_US,
3525	atom.AsFortran());
3526	} else {
3527	assert(top.first != operation::Operator::Identity &&
3528	"Handle this separately");
3529	context_.Say(rsrc,
3530	"The atomic variable %s should occur exactly once among the arguments of the top-level %s operator"_err_en_US,
3531	atom.AsFortran(), operation::ToString(top.first));
3532	}
3533	} else {
3534	CheckStorageOverlap(atom, nonAtom, source);
3535	}
3536	}
3537
3538	void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
3539	const SomeExpr &cond, parser::CharBlock condSource,
3540	const evaluate::Assignment &assign, parser::CharBlock assignSource) {
3541	auto [alsrc, arsrc]{SplitAssignmentSource(assignSource)};
3542	const SomeExpr &atom{assign.lhs};
3543
3544	if (!IsVarOrFunctionRef(atom)) {
3545	ErrorShouldBeVariable(atom, arsrc);
3546	// Skip other checks.
3547	return;
3548	}
3549
3550	CheckAtomicVariable(atom, alsrc);
3551
3552	auto top{GetTopLevelOperation(cond)};
3553	// Missing arguments to operations would have been diagnosed by now.
3554
3555	switch (top.first) {
3556	case operation::Operator::Associated:
3557	if (atom != top.second.front()) {
3558	context_.Say(assignSource,
3559	"The pointer argument to ASSOCIATED must be same as the target of the assignment"_err_en_US);
3560	}
3561	break;
3562	// x equalop e | e equalop x (allowing "e equalop x" is an extension)
3563	case operation::Operator::Eq:
3564	case operation::Operator::Eqv:
3565	// x ordop expr | expr ordop x
3566	case operation::Operator::Lt:
3567	case operation::Operator::Gt: {
3568	const SomeExpr &arg0{top.second[0]};
3569	const SomeExpr &arg1{top.second[1]};
3570	if (IsSameOrConvertOf(arg0, atom)) {
3571	CheckStorageOverlap(atom, {arg1}, condSource);
3572	} else if (IsSameOrConvertOf(arg1, atom)) {
3573	CheckStorageOverlap(atom, {arg0}, condSource);
3574	} else {
3575	assert(top.first != operation::Operator::Identity &&
3576	"Handle this separately");
3577	context_.Say(assignSource,
3578	"An argument of the %s operator should be the target of the assignment"_err_en_US,
3579	operation::ToString(top.first));
3580	}
3581	break;
3582	}
3583	case operation::Operator::Identity:
3584	case operation::Operator::True:
3585	case operation::Operator::False:
3586	break;
3587	default:
3588	assert(
3589	top.first != operation::Operator::Identity && "Handle this separately");
3590	context_.Say(condSource,
3591	"The %s operator is not a valid condition for ATOMIC operation"_err_en_US,
3592	operation::ToString(top.first));
3593	break;
3594	}
3595	}
3596
3597	void OmpStructureChecker::CheckAtomicConditionalUpdateStmt(
3598	const AnalyzedCondStmt &update, parser::CharBlock source) {
3599	// The condition/statements must be:
3600	// - cond: x equalop e ift: x = d iff: -
3601	// - cond: x ordop expr ift: x = expr iff: - (+ commute ordop)
3602	// - cond: associated(x) ift: x => expr iff: -
3603	// - cond: associated(x, e) ift: x => expr iff: -
3604
3605	// The if-true statement must be present, and must be an assignment.
3606	auto maybeAssign{GetEvaluateAssignment(update.ift.stmt)};
3607	if (!maybeAssign) {
3608	if (update.ift.stmt && !IsAssignment(update.ift.stmt)) {
3609	context_.Say(update.ift.source,
3610	"In ATOMIC UPDATE COMPARE the update statement should be an assignment"_err_en_US);
3611	} else {
3612	context_.Say(
3613	source, "Invalid body of ATOMIC UPDATE COMPARE operation"_err_en_US);
3614	}
3615	return;
3616	}
3617	const evaluate::Assignment assign{*maybeAssign};
3618	const SomeExpr &atom{assign.lhs};
3619
3620	CheckAtomicConditionalUpdateAssignment(
3621	update.cond, update.source, assign, update.ift.source);
3622
3623	CheckStorageOverlap(atom, {assign.rhs}, update.ift.source);
3624
3625	if (update.iff) {
3626	context_.Say(update.iff.source,
3627	"In ATOMIC UPDATE COMPARE the update statement should not have an ELSE branch"_err_en_US);
3628	}
3629	}
3630
3631	void OmpStructureChecker::CheckAtomicUpdateOnly(
3632	const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3633	parser::CharBlock source) {
3634	if (body.size() == 1) {
3635	SourcedActionStmt action{GetActionStmt(&body.front())};
3636	if (auto maybeUpdate{GetEvaluateAssignment(action.stmt)}) {
3637	const SomeExpr &atom{maybeUpdate->lhs};
3638	CheckAtomicUpdateAssignment(*maybeUpdate, action.source);
3639
3640	using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3641	x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3642	MakeAtomicAnalysisOp(Analysis::Update, maybeUpdate),
3643	MakeAtomicAnalysisOp(Analysis::None));
3644	} else if (!IsAssignment(action.stmt)) {
3645	context_.Say(
3646	source, "ATOMIC UPDATE operation should be an assignment"_err_en_US);
3647	}
3648	} else {
3649	context_.Say(x.source,
3650	"ATOMIC UPDATE operation should have a single statement"_err_en_US);
3651	}
3652	}
3653
3654	void OmpStructureChecker::CheckAtomicConditionalUpdate(
3655	const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3656	parser::CharBlock source) {
3657	// Allowable forms are (single-statement):
3658	// - if ...
3659	// - x = (... ? ... : x)
3660	// and two-statement:
3661	// - r = cond ; if (r) ...
3662
3663	const parser::ExecutionPartConstruct *ust{nullptr}; // update
3664	const parser::ExecutionPartConstruct *cst{nullptr}; // condition
3665
3666	if (body.size() == 1) {
3667	ust = &body.front();
3668	} else if (body.size() == 2) {
3669	cst = &body.front();
3670	ust = &body.back();
3671	} else {
3672	context_.Say(source,
3673	"ATOMIC UPDATE COMPARE operation should contain one or two statements"_err_en_US);
3674	return;
3675	}
3676
3677	// Flang doesn't support conditional-expr yet, so all update statements
3678	// are if-statements.
3679
3680	// IfStmt: if (...) ...
3681	// IfConstruct: if (...) then ... endif
3682	auto maybeUpdate{AnalyzeConditionalStmt(ust)};
3683	if (!maybeUpdate) {
3684	context_.Say(source,
3685	"In ATOMIC UPDATE COMPARE the update statement should be a conditional statement"_err_en_US);
3686	return;
3687	}
3688
3689	AnalyzedCondStmt &update{*maybeUpdate};
3690
3691	if (SourcedActionStmt action{GetActionStmt(cst)}) {
3692	// The "condition" statement must be `r = cond`.
3693	if (auto maybeCond{GetEvaluateAssignment(action.stmt)}) {
3694	if (maybeCond->lhs != update.cond) {
3695	context_.Say(update.source,
3696	"In ATOMIC UPDATE COMPARE the conditional statement must use %s as the condition"_err_en_US,
3697	maybeCond->lhs.AsFortran());
3698	} else {
3699	// If it's "r = ...; if (r) ..." then put the original condition
3700	// in `update`.
3701	update.cond = maybeCond->rhs;
3702	}
3703	} else {
3704	context_.Say(action.source,
3705	"In ATOMIC UPDATE COMPARE with two statements the first statement should compute the condition"_err_en_US);
3706	}
3707	}
3708
3709	evaluate::Assignment assign{*GetEvaluateAssignment(update.ift.stmt)};
3710
3711	CheckAtomicConditionalUpdateStmt(update, source);
3712	if (IsCheckForAssociated(update.cond)) {
3713	if (!IsPointerAssignment(assign)) {
3714	context_.Say(source,
3715	"The assignment should be a pointer-assignment when the condition is ASSOCIATED"_err_en_US);
3716	}
3717	} else {
3718	if (IsPointerAssignment(assign)) {
3719	context_.Say(source,
3720	"The assignment cannot be a pointer-assignment except when the condition is ASSOCIATED"_err_en_US);
3721	}
3722	}
3723
3724	using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3725	x.analysis = MakeAtomicAnalysis(assign.lhs, update.cond,
3726	MakeAtomicAnalysisOp(Analysis::Update | Analysis::IfTrue, assign),
3727	MakeAtomicAnalysisOp(Analysis::None));
3728	}
3729
3730	void OmpStructureChecker::CheckAtomicUpdateCapture(
3731	const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3732	parser::CharBlock source) {
3733	if (body.size() != 2) {
3734	context_.Say(source,
3735	"ATOMIC UPDATE operation with CAPTURE should contain two statements"_err_en_US);
3736	return;
3737	}
3738
3739	auto [uec, cec]{CheckUpdateCapture(&body.front(), &body.back(), source)};
3740	if (!uec || !cec) {
3741	// Diagnostics already emitted.
3742	return;
3743	}
3744	SourcedActionStmt uact{GetActionStmt(uec)};
3745	SourcedActionStmt cact{GetActionStmt(cec)};
3746	// The "dereferences" of std::optional are guaranteed to be valid after
3747	// CheckUpdateCapture.
3748	evaluate::Assignment update{*GetEvaluateAssignment(uact.stmt)};
3749	evaluate::Assignment capture{*GetEvaluateAssignment(cact.stmt)};
3750
3751	const SomeExpr &atom{update.lhs};
3752
3753	using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3754	int action;
3755
3756	if (IsMaybeAtomicWrite(update)) {
3757	action = Analysis::Write;
3758	CheckAtomicWriteAssignment(update, uact.source);
3759	} else {
3760	action = Analysis::Update;
3761	CheckAtomicUpdateAssignment(update, uact.source);
3762	}
3763	CheckAtomicCaptureAssignment(capture, atom, cact.source);
3764
3765	if (IsPointerAssignment(update) != IsPointerAssignment(capture)) {
3766	context_.Say(cact.source,
3767	"The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
3768	return;
3769	}
3770
3771	if (GetActionStmt(&body.front()).stmt == uact.stmt) {
3772	x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3773	MakeAtomicAnalysisOp(action, update),
3774	MakeAtomicAnalysisOp(Analysis::Read, capture));
3775	} else {
3776	x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3777	MakeAtomicAnalysisOp(Analysis::Read, capture),
3778	MakeAtomicAnalysisOp(action, update));
3779	}
3780	}
3781
3782	void OmpStructureChecker::CheckAtomicConditionalUpdateCapture(
3783	const parser::OpenMPAtomicConstruct &x, const parser::Block &body,
3784	parser::CharBlock source) {
3785	// There are two different variants of this:
3786	// (1) conditional-update and capture separately:
3787	// This form only allows single-statement updates, i.e. the update
3788	// form "r = cond; if (r) ..." is not allowed.
3789	// (2) conditional-update combined with capture in a single statement:
3790	// This form does allow the condition to be calculated separately,
3791	// i.e. "r = cond; if (r) ...".
3792	// Regardless of what form it is, the actual update assignment is a
3793	// proper write, i.e. "x = d", where d does not depend on x.
3794
3795	AnalyzedCondStmt update;
3796	SourcedActionStmt capture;
3797	bool captureAlways{true}, captureFirst{true};
3798
3799	auto extractCapture{[&]() {
3800	capture = update.iff;
3801	captureAlways = false;
3802	update.iff = SourcedActionStmt{};
3803	}};
3804
3805	auto classifyNonUpdate{[&](const SourcedActionStmt &action) {
3806	// The non-update statement is either "r = cond" or the capture.
3807	if (auto maybeAssign{GetEvaluateAssignment(action.stmt)}) {
3808	if (update.cond == maybeAssign->lhs) {
3809	// If this is "r = cond; if (r) ...", then update the condition.
3810	update.cond = maybeAssign->rhs;
3811	update.source = action.source;
3812	// In this form, the update and the capture are combined into
3813	// an IF-THEN-ELSE statement.
3814	extractCapture();
3815	} else {
3816	// Assume this is the capture-statement.
3817	capture = action;
3818	}
3819	}
3820	}};
3821
3822	if (body.size() == 2) {
3823	// This could be
3824	// - capture; conditional-update (in any order), or
3825	// - r = cond; if (r) capture-update
3826	const parser::ExecutionPartConstruct *st1{&body.front()};
3827	const parser::ExecutionPartConstruct *st2{&body.back()};
3828	// In either case, the conditional statement can be analyzed by
3829	// AnalyzeConditionalStmt, whereas the other statement cannot.
3830	if (auto maybeUpdate1{AnalyzeConditionalStmt(st1)}) {
3831	update = *maybeUpdate1;
3832	classifyNonUpdate(GetActionStmt(st2));
3833	captureFirst = false;
3834	} else if (auto maybeUpdate2{AnalyzeConditionalStmt(st2)}) {
3835	update = *maybeUpdate2;
3836	classifyNonUpdate(GetActionStmt(st1));
3837	} else {
3838	// None of the statements are conditional, this rules out the
3839	// "r = cond; if (r) ..." and the "capture + conditional-update"
3840	// variants. This could still be capture + write (which is classified
3841	// as conditional-update-capture in the spec).
3842	auto [uec, cec]{CheckUpdateCapture(st1, st2, source)};
3843	if (!uec || !cec) {
3844	// Diagnostics already emitted.
3845	return;
3846	}
3847	SourcedActionStmt uact{GetActionStmt(uec)};
3848	SourcedActionStmt cact{GetActionStmt(cec)};
3849	update.ift = uact;
3850	capture = cact;
3851	if (uec == st1) {
3852	captureFirst = false;
3853	}
3854	}
3855	} else if (body.size() == 1) {
3856	if (auto maybeUpdate{AnalyzeConditionalStmt(&body.front())}) {
3857	update = *maybeUpdate;
3858	// This is the form with update and capture combined into an IF-THEN-ELSE
3859	// statement. The capture-statement is always the ELSE branch.
3860	extractCapture();
3861	} else {
3862	goto invalid;
3863	}
3864	} else {
3865	context_.Say(source,
3866	"ATOMIC UPDATE COMPARE CAPTURE operation should contain one or two statements"_err_en_US);
3867	return;
3868	invalid:
3869	context_.Say(source,
3870	"Invalid body of ATOMIC UPDATE COMPARE CAPTURE operation"_err_en_US);
3871	return;
3872	}
3873
3874	// The update must have a form `x = d` or `x => d`.
3875	if (auto maybeWrite{GetEvaluateAssignment(update.ift.stmt)}) {
3876	const SomeExpr &atom{maybeWrite->lhs};
3877	CheckAtomicWriteAssignment(*maybeWrite, update.ift.source);
3878	if (auto maybeCapture{GetEvaluateAssignment(capture.stmt)}) {
3879	CheckAtomicCaptureAssignment(*maybeCapture, atom, capture.source);
3880
3881	if (IsPointerAssignment(*maybeWrite) !=
3882	IsPointerAssignment(*maybeCapture)) {
3883	context_.Say(capture.source,
3884	"The update and capture assignments should both be pointer-assignments or both be non-pointer-assignments"_err_en_US);
3885	return;
3886	}
3887	} else {
3888	if (!IsAssignment(capture.stmt)) {
3889	context_.Say(capture.source,
3890	"In ATOMIC UPDATE COMPARE CAPTURE the capture statement should be an assignment"_err_en_US);
3891	}
3892	return;
3893	}
3894	} else {
3895	if (!IsAssignment(update.ift.stmt)) {
3896	context_.Say(update.ift.source,
3897	"In ATOMIC UPDATE COMPARE CAPTURE the update statement should be an assignment"_err_en_US);
3898	}
3899	return;
3900	}
3901
3902	// update.iff should be empty here, the capture statement should be
3903	// stored in "capture".
3904
3905	// Fill out the analysis in the AST node.
3906	using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3907	bool condUnused{std::visit(
3908	[](auto &&s) {
3909	using BareS = llvm::remove_cvref_t<decltype(s)>;
3910	if constexpr (std::is_same_v<BareS, evaluate::NullPointer>) {
3911	return true;
3912	} else {
3913	return false;
3914	}
3915	},
3916	update.cond.u)};
3917
3918	int updateWhen{!condUnused ? Analysis::IfTrue : 0};
3919	int captureWhen{!captureAlways ? Analysis::IfFalse : 0};
3920
3921	evaluate::Assignment updAssign{*GetEvaluateAssignment(update.ift.stmt)};
3922	evaluate::Assignment capAssign{*GetEvaluateAssignment(capture.stmt)};
3923
3924	if (captureFirst) {
3925	x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
3926	MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign),
3927	MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign));
3928	} else {
3929	x.analysis = MakeAtomicAnalysis(updAssign.lhs, update.cond,
3930	MakeAtomicAnalysisOp(Analysis::Write | updateWhen, updAssign),
3931	MakeAtomicAnalysisOp(Analysis::Read | captureWhen, capAssign));
3932	}
3933	}
3934
3935	void OmpStructureChecker::CheckAtomicRead(
3936	const parser::OpenMPAtomicConstruct &x) {
3937	// [6.0:190:5-7]
3938	// A read structured block is read-statement, a read statement that has one
3939	// of the following forms:
3940	// v = x
3941	// v => x
3942	auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
3943	auto &block{std::get<parser::Block>(x.t)};
3944
3945	// Read cannot be conditional or have a capture statement.
3946	if (x.IsCompare() || x.IsCapture()) {
3947	context_.Say(dirSpec.source,
3948	"ATOMIC READ cannot have COMPARE or CAPTURE clauses"_err_en_US);
3949	return;
3950	}
3951
3952	const parser::Block &body{GetInnermostExecPart(block)};
3953
3954	if (body.size() == 1) {
3955	SourcedActionStmt action{GetActionStmt(&body.front())};
3956	if (auto maybeRead{GetEvaluateAssignment(action.stmt)}) {
3957	CheckAtomicReadAssignment(*maybeRead, action.source);
3958
3959	if (auto maybe{GetConvertInput(maybeRead->rhs)}) {
3960	const SomeExpr &atom{*maybe};
3961	using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3962	x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3963	MakeAtomicAnalysisOp(Analysis::Read, maybeRead),
3964	MakeAtomicAnalysisOp(Analysis::None));
3965	}
3966	} else if (!IsAssignment(action.stmt)) {
3967	context_.Say(
3968	x.source, "ATOMIC READ operation should be an assignment"_err_en_US);
3969	}
3970	} else {
3971	context_.Say(x.source,
3972	"ATOMIC READ operation should have a single statement"_err_en_US);
3973	}
3974	}
3975
3976	void OmpStructureChecker::CheckAtomicWrite(
3977	const parser::OpenMPAtomicConstruct &x) {
3978	auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
3979	auto &block{std::get<parser::Block>(x.t)};
3980
3981	// Write cannot be conditional or have a capture statement.
3982	if (x.IsCompare() || x.IsCapture()) {
3983	context_.Say(dirSpec.source,
3984	"ATOMIC WRITE cannot have COMPARE or CAPTURE clauses"_err_en_US);
3985	return;
3986	}
3987
3988	const parser::Block &body{GetInnermostExecPart(block)};
3989
3990	if (body.size() == 1) {
3991	SourcedActionStmt action{GetActionStmt(&body.front())};
3992	if (auto maybeWrite{GetEvaluateAssignment(action.stmt)}) {
3993	const SomeExpr &atom{maybeWrite->lhs};
3994	CheckAtomicWriteAssignment(*maybeWrite, action.source);
3995
3996	using Analysis = parser::OpenMPAtomicConstruct::Analysis;
3997	x.analysis = MakeAtomicAnalysis(atom, std::nullopt,
3998	MakeAtomicAnalysisOp(Analysis::Write, maybeWrite),
3999	MakeAtomicAnalysisOp(Analysis::None));
4000	} else if (!IsAssignment(action.stmt)) {
4001	context_.Say(
4002	x.source, "ATOMIC WRITE operation should be an assignment"_err_en_US);
4003	}
4004	} else {
4005	context_.Say(x.source,
4006	"ATOMIC WRITE operation should have a single statement"_err_en_US);
4007	}
4008	}
4009
4010	void OmpStructureChecker::CheckAtomicUpdate(
4011	const parser::OpenMPAtomicConstruct &x) {
4012	auto &block{std::get<parser::Block>(x.t)};
4013
4014	bool isConditional{x.IsCompare()};
4015	bool isCapture{x.IsCapture()};
4016	const parser::Block &body{GetInnermostExecPart(block)};
4017
4018	if (isConditional && isCapture) {
4019	CheckAtomicConditionalUpdateCapture(x, body, x.source);
4020	} else if (isConditional) {
4021	CheckAtomicConditionalUpdate(x, body, x.source);
4022	} else if (isCapture) {
4023	CheckAtomicUpdateCapture(x, body, x.source);
4024	} else { // update-only
4025	CheckAtomicUpdateOnly(x, body, x.source);
4026	}
4027	}
4028
4029	void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
4030	// All of the following groups have the "exclusive" property, i.e. at
4031	// most one clause from each group is allowed.
4032	// The exclusivity-checking code should eventually be unified for all
4033	// clauses, with clause groups defined in OMP.td.
4034	std::array atomic{llvm::omp::Clause::OMPC_read,
4035	llvm::omp::Clause::OMPC_update, llvm::omp::Clause::OMPC_write};
4036	std::array memoryOrder{llvm::omp::Clause::OMPC_acq_rel,
4037	llvm::omp::Clause::OMPC_acquire, llvm::omp::Clause::OMPC_relaxed,
4038	llvm::omp::Clause::OMPC_release, llvm::omp::Clause::OMPC_seq_cst};
4039
4040	auto checkExclusive{[&](llvm::ArrayRef<llvm::omp::Clause> group,
4041	std::string_view name,
4042	const parser::OmpClauseList &clauses) {
4043	const parser::OmpClause *present{nullptr};
4044	for (const parser::OmpClause &clause : clauses.v) {
4045	llvm::omp::Clause id{clause.Id()};
4046	if (!llvm::is_contained(group, id)) {
4047	continue;
4048	}
4049	if (present == nullptr) {
4050	present = &clause;
4051	continue;
4052	} else if (id == present->Id()) {
4053	// Ignore repetitions of the same clause, those will be diagnosed
4054	// separately.
4055	continue;
4056	}
4057	parser::MessageFormattedText txt(
4058	"At most one clause from the '%s' group is allowed on ATOMIC construct"_err_en_US,
4059	name.data());
4060	parser::Message message(clause.source, txt);
4061	message.Attach(present->source,
4062	"Previous clause from this group provided here"_en_US);
4063	context_.Say(std::move(message));
4064	return;
4065	}
4066	}};
4067
4068	auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
4069	auto &dir{std::get<parser::OmpDirectiveName>(dirSpec.t)};
4070	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_atomic);
4071	llvm::omp::Clause kind{x.GetKind()};
4072
4073	checkExclusive(atomic, "atomic", dirSpec.Clauses());
4074	checkExclusive(memoryOrder, "memory-order", dirSpec.Clauses());
4075
4076	switch (kind) {
4077	case llvm::omp::Clause::OMPC_read:
4078	CheckAtomicRead(x);
4079	break;
4080	case llvm::omp::Clause::OMPC_write:
4081	CheckAtomicWrite(x);
4082	break;
4083	case llvm::omp::Clause::OMPC_update:
4084	CheckAtomicUpdate(x);
4085	break;
4086	default:
4087	break;
4088	}
4089	}
4090
4091	void OmpStructureChecker::Leave(const parser::OpenMPAtomicConstruct &) {
4092	dirContext_.pop_back();
4093	}
4094
4095	// Clauses
4096	// Mainly categorized as
4097	// 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
4098	// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
4099	// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
4100
4101	void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
4102	// 2.7.1 Loop Construct Restriction
4103	if (llvm::omp::allDoSet.test(GetContext().directive)) {
4104	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
4105	// only one schedule clause is allowed
4106	const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
4107	auto &modifiers{OmpGetModifiers(schedClause.v)};
4108	auto *ordering{
4109	OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};
4110	if (ordering &&
4111	ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {
4112	if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
4113	context_.Say(clause->source,
4114	"The NONMONOTONIC modifier cannot be specified "
4115	"if an ORDERED clause is specified"_err_en_US);
4116	}
4117	}
4118	}
4119
4120	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
4121	// only one ordered clause is allowed
4122	const auto &orderedClause{
4123	std::get<parser::OmpClause::Ordered>(clause->u)};
4124
4125	if (orderedClause.v) {
4126	CheckNotAllowedIfClause(
4127	llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
4128
4129	if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
4130	const auto &collapseClause{
4131	std::get<parser::OmpClause::Collapse>(clause2->u)};
4132	// ordered and collapse both have parameters
4133	if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
4134	if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
4135	if (*orderedValue > 0 && *orderedValue < *collapseValue) {
4136	context_.Say(clause->source,
4137	"The parameter of the ORDERED clause must be "
4138	"greater than or equal to "
4139	"the parameter of the COLLAPSE clause"_err_en_US);
4140	}
4141	}
4142	}
4143	}
4144	}
4145
4146	// TODO: ordered region binding check (requires nesting implementation)
4147	}
4148	} // doSet
4149
4150	// 2.8.1 Simd Construct Restriction
4151	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
4152	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
4153	if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
4154	const auto &simdlenClause{
4155	std::get<parser::OmpClause::Simdlen>(clause->u)};
4156	const auto &safelenClause{
4157	std::get<parser::OmpClause::Safelen>(clause2->u)};
4158	// simdlen and safelen both have parameters
4159	if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
4160	if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
4161	if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
4162	context_.Say(clause->source,
4163	"The parameter of the SIMDLEN clause must be less than or "
4164	"equal to the parameter of the SAFELEN clause"_err_en_US);
4165	}
4166	}
4167	}
4168	}
4169	}
4170
4171	// 2.11.5 Simd construct restriction (OpenMP 5.1)
4172	if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
4173	if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) {
4174	const auto &orderClause{
4175	std::get<parser::OmpClause::Order>(o_clause->u)};
4176	if (std::get<parser::OmpOrderClause::Ordering>(orderClause.v.t) ==
4177	parser::OmpOrderClause::Ordering::Concurrent) {
4178	context_.Say(sl_clause->source,
4179	"The `SAFELEN` clause cannot appear in the `SIMD` directive "
4180	"with `ORDER(CONCURRENT)` clause"_err_en_US);
4181	}
4182	}
4183	}
4184	} // SIMD
4185
4186	// Semantic checks related to presence of multiple list items within the same
4187	// clause
4188	CheckMultListItems();
4189
4190	if (GetContext().directive == llvm::omp::Directive::OMPD_task) {
4191	if (auto *detachClause{FindClause(llvm::omp::Clause::OMPC_detach)}) {
4192	unsigned version{context_.langOptions().OpenMPVersion};
4193	if (version == 50 || version == 51) {
4194	// OpenMP 5.0: 2.10.1 Task construct restrictions
4195	CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_detach,
4196	{llvm::omp::Clause::OMPC_mergeable});
4197	} else if (version >= 52) {
4198	// OpenMP 5.2: 12.5.2 Detach construct restrictions
4199	if (FindClause(llvm::omp::Clause::OMPC_final)) {
4200	context_.Say(GetContext().clauseSource,
4201	"If a DETACH clause appears on a directive, then the encountering task must not be a FINAL task"_err_en_US);
4202	}
4203
4204	const auto &detach{
4205	std::get<parser::OmpClause::Detach>(detachClause->u)};
4206	if (const auto *name{parser::Unwrap<parser::Name>(detach.v.v)}) {
4207	Symbol *eventHandleSym{name->symbol};
4208	auto checkVarAppearsInDataEnvClause = [&](const parser::OmpObjectList
4209	&objs,
4210	std::string clause) {
4211	for (const auto &obj : objs.v) {
4212	if (const parser::Name *
4213	objName{parser::Unwrap<parser::Name>(obj)}) {
4214	if (&objName->symbol->GetUltimate() == eventHandleSym) {
4215	context_.Say(GetContext().clauseSource,
4216	"A variable: `%s` that appears in a DETACH clause cannot appear on %s clause on the same construct"_err_en_US,
4217	objName->source, clause);
4218	}
4219	}
4220	}
4221	};
4222	if (auto *dataEnvClause{
4223	FindClause(llvm::omp::Clause::OMPC_private)}) {
4224	const auto &pClause{
4225	std::get<parser::OmpClause::Private>(dataEnvClause->u)};
4226	checkVarAppearsInDataEnvClause(pClause.v, "PRIVATE");
4227	} else if (auto *dataEnvClause{
4228	FindClause(llvm::omp::Clause::OMPC_shared)}) {
4229	const auto &sClause{
4230	std::get<parser::OmpClause::Shared>(dataEnvClause->u)};
4231	checkVarAppearsInDataEnvClause(sClause.v, "SHARED");
4232	} else if (auto *dataEnvClause{
4233	FindClause(llvm::omp::Clause::OMPC_firstprivate)}) {
4234	const auto &fpClause{
4235	std::get<parser::OmpClause::Firstprivate>(dataEnvClause->u)};
4236	checkVarAppearsInDataEnvClause(fpClause.v, "FIRSTPRIVATE");
4237	} else if (auto *dataEnvClause{
4238	FindClause(llvm::omp::Clause::OMPC_in_reduction)}) {
4239	const auto &irClause{
4240	std::get<parser::OmpClause::InReduction>(dataEnvClause->u)};
4241	checkVarAppearsInDataEnvClause(
4242	std::get<parser::OmpObjectList>(irClause.v.t), "IN_REDUCTION");
4243	}
4244	}
4245	}
4246	}
4247	}
4248
4249	auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name,
4250	llvmOmpClause clauseTy) {
4251	if (sym.test(Symbol::Flag::OmpThreadprivate))
4252	context_.Say(name.source,
4253	"A THREADPRIVATE variable cannot be in %s clause"_err_en_US,
4254	parser::ToUpperCaseLetters(getClauseName(clauseTy).str()));
4255	};
4256
4257	// [5.1] 2.21.2 Threadprivate Directive Restriction
4258	OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin,
4259	llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule,
4260	llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit,
4261	llvm::omp::Clause::OMPC_if};
4262	for (auto it : GetContext().clauseInfo) {
4263	llvmOmpClause type = it.first;
4264	const auto *clause = it.second;
4265	if (!threadprivateAllowedSet.test(type)) {
4266	if (const auto *objList{GetOmpObjectList(*clause)}) {
4267	for (const auto &ompObject : objList->v) {
4268	common::visit(
4269	common::visitors{
4270	[&](const parser::Designator &) {
4271	if (const auto *name{
4272	parser::Unwrap<parser::Name>(ompObject)}) {
4273	if (name->symbol) {
4274	testThreadprivateVarErr(
4275	name->symbol->GetUltimate(), *name, type);
4276	}
4277	}
4278	},
4279	[&](const parser::Name &name) {
4280	if (name.symbol) {
4281	for (const auto &mem :
4282	name.symbol->get<CommonBlockDetails>().objects()) {
4283	testThreadprivateVarErr(mem->GetUltimate(), name, type);
4284	break;
4285	}
4286	}
4287	},
4288	},
4289	ompObject.u);
4290	}
4291	}
4292	}
4293	}
4294
4295	CheckRequireAtLeastOneOf();
4296	}
4297
4298	void OmpStructureChecker::Enter(const parser::OmpClause &x) {
4299	SetContextClause(x);
4300
4301	// The visitors for these clauses do their own checks.
4302	switch (x.Id()) {
4303	case llvm::omp::Clause::OMPC_copyprivate:
4304	case llvm::omp::Clause::OMPC_enter:
4305	case llvm::omp::Clause::OMPC_lastprivate:
4306	case llvm::omp::Clause::OMPC_reduction:
4307	case llvm::omp::Clause::OMPC_to:
4308	return;
4309	default:
4310	break;
4311	}
4312
4313	if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) {
4314	SymbolSourceMap symbols;
4315	GetSymbolsInObjectList(*objList, symbols);
4316	for (const auto &[symbol, source] : symbols) {
4317	if (!IsVariableListItem(*symbol)) {
4318	deferredNonVariables_.insert({symbol, source});
4319	}
4320	}
4321	}
4322	}
4323
4324	// Following clauses do not have a separate node in parse-tree.h.
4325	CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent)
4326	CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
4327	CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
4328	CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains)
4329	CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
4330	CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
4331	CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
4332	CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
4333	CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
4334	CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
4335	CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
4336	CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
4337	CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize)
4338	CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds)
4339	CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
4340	CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer)
4341	CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
4342	CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
4343	CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks)
4344	CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
4345	CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
4346	CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
4347	CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
4348	CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
4349	CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
4350	CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect)
4351	CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
4352	CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp)
4353	CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines)
4354	CHECK_SIMPLE_CLAUSE(NoOpenmpConstructs, OMPC_no_openmp_constructs)
4355	CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism)
4356	CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
4357	CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
4358	CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
4359	CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
4360	CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
4361	CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
4362	CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation)
4363	CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
4364	CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
4365	CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
4366	CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
4367	CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
4368	CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
4369	CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
4370	CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
4371	CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
4372	CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
4373	CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
4374	CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
4375	CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise)
4376	CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)
4377	CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)
4378	CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)
4379	CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)
4380	CHECK_SIMPLE_CLAUSE(Align, OMPC_align)
4381	CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)
4382	CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)
4383	CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak)
4384	CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
4385	CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
4386	CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
4387	CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
4388	CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
4389	CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)
4390
4391	CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
4392	CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
4393	CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem)
4394	CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
4395	CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
4396
4397	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
4398	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
4399	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
4400
4401	// Restrictions specific to each clause are implemented apart from the
4402	// generalized restrictions.
4403
4404	void OmpStructureChecker::Enter(const parser::OmpClause::Destroy &x) {
4405	CheckAllowedClause(llvm::omp::Clause::OMPC_destroy);
4406
4407	llvm::omp::Directive dir{GetContext().directive};
4408	unsigned version{context_.langOptions().OpenMPVersion};
4409	if (dir == llvm::omp::Directive::OMPD_depobj) {
4410	unsigned argSince{52}, noargDeprecatedIn{52};
4411	if (x.v) {
4412	if (version < argSince) {
4413	context_.Say(GetContext().clauseSource,
4414	"The object parameter in DESTROY clause on DEPOPJ construct is not allowed in %s, %s"_warn_en_US,
4415	ThisVersion(version), TryVersion(argSince));
4416	}
4417	} else {
4418	if (version >= noargDeprecatedIn) {
4419	context_.Say(GetContext().clauseSource,
4420	"The DESTROY clause without argument on DEPOBJ construct is deprecated in %s"_warn_en_US,
4421	ThisVersion(noargDeprecatedIn));
4422	}
4423	}
4424	}
4425	}
4426
4427	void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
4428	CheckAllowedClause(llvm::omp::Clause::OMPC_reduction);
4429	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
4430
4431	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_reduction,
4432	GetContext().clauseSource, context_)) {
4433	auto &modifiers{OmpGetModifiers(x.v)};
4434	const auto *ident{
4435	OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
4436	assert(ident && "reduction-identifier is a required modifier");
4437	if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
4438	llvm::omp::OMPC_reduction)) {
4439	CheckReductionObjectTypes(objects, *ident);
4440	}
4441	using ReductionModifier = parser::OmpReductionModifier;
4442	if (auto *modifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)}) {
4443	CheckReductionModifier(*modifier);
4444	}
4445	}
4446	CheckReductionObjects(objects, llvm::omp::Clause::OMPC_reduction);
4447
4448	// If this is a worksharing construct then ensure the reduction variable
4449	// is not private in the parallel region that it binds to.
4450	if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) {
4451	CheckSharedBindingInOuterContext(objects);
4452	}
4453
4454	if (GetContext().directive == llvm::omp::Directive::OMPD_loop) {
4455	for (auto clause : GetContext().clauseInfo) {
4456	if (const auto *bindClause{
4457	std::get_if<parser::OmpClause::Bind>(&clause.second->u)}) {
4458	if (bindClause->v.v == parser::OmpBindClause::Binding::Teams) {
4459	context_.Say(GetContext().clauseSource,
4460	"'REDUCTION' clause not allowed with '!$OMP LOOP BIND(TEAMS)'."_err_en_US);
4461	}
4462	}
4463	}
4464	}
4465	}
4466
4467	void OmpStructureChecker::Enter(const parser::OmpClause::InReduction &x) {
4468	CheckAllowedClause(llvm::omp::Clause::OMPC_in_reduction);
4469	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
4470
4471	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_in_reduction,
4472	GetContext().clauseSource, context_)) {
4473	auto &modifiers{OmpGetModifiers(x.v)};
4474	const auto *ident{
4475	OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
4476	assert(ident && "reduction-identifier is a required modifier");
4477	if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
4478	llvm::omp::OMPC_in_reduction)) {
4479	CheckReductionObjectTypes(objects, *ident);
4480	}
4481	}
4482	CheckReductionObjects(objects, llvm::omp::Clause::OMPC_in_reduction);
4483	}
4484
4485	void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) {
4486	CheckAllowedClause(llvm::omp::Clause::OMPC_task_reduction);
4487	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
4488
4489	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_task_reduction,
4490	GetContext().clauseSource, context_)) {
4491	auto &modifiers{OmpGetModifiers(x.v)};
4492	const auto *ident{
4493	OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
4494	assert(ident && "reduction-identifier is a required modifier");
4495	if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
4496	llvm::omp::OMPC_task_reduction)) {
4497	CheckReductionObjectTypes(objects, *ident);
4498	}
4499	}
4500	CheckReductionObjects(objects, llvm::omp::Clause::OMPC_task_reduction);
4501	}
4502
4503	bool OmpStructureChecker::CheckReductionOperator(
4504	const parser::OmpReductionIdentifier &ident, parser::CharBlock source,
4505	llvm::omp::Clause clauseId) {
4506	auto visitOperator{[&](const parser::DefinedOperator &dOpr) {
4507	if (const auto *intrinsicOp{
4508	std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {
4509	switch (*intrinsicOp) {
4510	case parser::DefinedOperator::IntrinsicOperator::Add:
4511	case parser::DefinedOperator::IntrinsicOperator::Multiply:
4512	case parser::DefinedOperator::IntrinsicOperator::AND:
4513	case parser::DefinedOperator::IntrinsicOperator::OR:
4514	case parser::DefinedOperator::IntrinsicOperator::EQV:
4515	case parser::DefinedOperator::IntrinsicOperator::NEQV:
4516	return true;
4517	case parser::DefinedOperator::IntrinsicOperator::Subtract:
4518	context_.Say(GetContext().clauseSource,
4519	"The minus reduction operator is deprecated since OpenMP 5.2 and is not supported in the REDUCTION clause."_err_en_US,
4520	ContextDirectiveAsFortran());
4521	return false;
4522	default:
4523	break;
4524	}
4525	}
4526	// User-defined operators are OK if there has been a declared reduction
4527	// for that. We mangle those names to store the user details.
4528	if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
4529	std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
4530	const Scope &scope{definedOp->v.symbol->owner()};
4531	if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
4532	if (symbol->detailsIf<UserReductionDetails>()) {
4533	return true;
4534	}
4535	}
4536	}
4537	context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,
4538	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4539	return false;
4540	}};
4541
4542	auto visitDesignator{[&](const parser::ProcedureDesignator &procD) {
4543	const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
4544	bool valid{false};
4545	if (name && name->symbol) {
4546	const SourceName &realName{name->symbol->GetUltimate().name()};
4547	valid =
4548	llvm::is_contained(Set: {"max", "min", "iand", "ior", "ieor"}, Element: realName);
4549	if (!valid) {
4550	valid = name->symbol->detailsIf<UserReductionDetails>();
4551	}
4552	}
4553	if (!valid) {
4554	context_.Say(source,
4555	"Invalid reduction identifier in %s clause."_err_en_US,
4556	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4557	}
4558	return valid;
4559	}};
4560
4561	return common::visit(
4562	common::visitors{visitOperator, visitDesignator}, ident.u);
4563	}
4564
4565	/// Check restrictions on objects that are common to all reduction clauses.
4566	void OmpStructureChecker::CheckReductionObjects(
4567	const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
4568	unsigned version{context_.langOptions().OpenMPVersion};
4569	SymbolSourceMap symbols;
4570	GetSymbolsInObjectList(objects, symbols);
4571
4572	// Array sections must be a contiguous storage, have non-zero length.
4573	for (const parser::OmpObject &object : objects.v) {
4574	CheckIfContiguous(object);
4575	}
4576	CheckReductionArraySection(objects, clauseId);
4577	// An object must be definable.
4578	CheckDefinableObjects(symbols, clauseId);
4579	// Procedure pointers are not allowed.
4580	CheckProcedurePointer(symbols, clauseId);
4581	// Pointers must not have INTENT(IN).
4582	CheckIntentInPointer(symbols, clauseId);
4583
4584	// Disallow common blocks.
4585	// Iterate on objects because `GetSymbolsInObjectList` expands common block
4586	// names into the lists of their members.
4587	for (const parser::OmpObject &object : objects.v) {
4588	auto *symbol{GetObjectSymbol(object)};
4589	if (symbol && IsCommonBlock(*symbol)) {
4590	auto source{GetObjectSource(object)};
4591	context_.Say(source ? *source : GetContext().clauseSource,
4592	"Common block names are not allowed in %s clause"_err_en_US,
4593	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4594	}
4595	}
4596
4597	// Denied in all current versions of the standard because structure components
4598	// are not definable (i.e. they are expressions not variables).
4599	// Object cannot be a part of another object (except array elements).
4600	CheckStructureComponent(objects, clauseId);
4601
4602	if (version >= 50) {
4603	// If object is an array section or element, the base expression must be
4604	// a language identifier.
4605	for (const parser::OmpObject &object : objects.v) {
4606	if (auto *elem{GetArrayElementFromObj(object)}) {
4607	const parser::DataRef &base = elem->base;
4608	if (!std::holds_alternative<parser::Name>(base.u)) {
4609	auto source{GetObjectSource(object)};
4610	context_.Say(source ? *source : GetContext().clauseSource,
4611	"The base expression of an array element or section in %s clause must be an identifier"_err_en_US,
4612	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4613	}
4614	}
4615	}
4616	// Type parameter inquiries are not allowed.
4617	for (const parser::OmpObject &object : objects.v) {
4618	if (auto *dataRef{GetDataRefFromObj(object)}) {
4619	if (IsDataRefTypeParamInquiry(dataRef)) {
4620	auto source{GetObjectSource(object)};
4621	context_.Say(source ? *source : GetContext().clauseSource,
4622	"Type parameter inquiry is not permitted in %s clause"_err_en_US,
4623	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4624	}
4625	}
4626	}
4627	}
4628	}
4629
4630	static bool CheckSymbolSupportsType(const Scope &scope,
4631	const parser::CharBlock &name, const DeclTypeSpec &type) {
4632	if (const auto *symbol{scope.FindSymbol(name)}) {
4633	if (const auto *reductionDetails{
4634	symbol->detailsIf<UserReductionDetails>()}) {
4635	return reductionDetails->SupportsType(type);
4636	}
4637	}
4638	return false;
4639	}
4640
4641	static bool IsReductionAllowedForType(
4642	const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
4643	const Scope &scope, SemanticsContext &context) {
4644	auto isLogical{[](const DeclTypeSpec &type) -> bool {
4645	return type.category() == DeclTypeSpec::Logical;
4646	}};
4647	auto isCharacter{[](const DeclTypeSpec &type) -> bool {
4648	return type.category() == DeclTypeSpec::Character;
4649	}};
4650
4651	auto checkOperator{[&](const parser::DefinedOperator &dOpr) {
4652	if (const auto *intrinsicOp{
4653	std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {
4654	// OMP5.2: The type [...] of a list item that appears in a
4655	// reduction clause must be valid for the combiner expression
4656	// See F2023: Table 10.2
4657	// .LT., .LE., .GT., .GE. are handled as procedure designators
4658	// below.
4659	switch (*intrinsicOp) {
4660	case parser::DefinedOperator::IntrinsicOperator::Multiply:
4661	case parser::DefinedOperator::IntrinsicOperator::Add:
4662	case parser::DefinedOperator::IntrinsicOperator::Subtract:
4663	if (type.IsNumeric(TypeCategory::Integer) ||
4664	type.IsNumeric(TypeCategory::Real) ||
4665	type.IsNumeric(TypeCategory::Complex))
4666	return true;
4667	break;
4668
4669	case parser::DefinedOperator::IntrinsicOperator::AND:
4670	case parser::DefinedOperator::IntrinsicOperator::OR:
4671	case parser::DefinedOperator::IntrinsicOperator::EQV:
4672	case parser::DefinedOperator::IntrinsicOperator::NEQV:
4673	if (isLogical(type)) {
4674	return true;
4675	}
4676	break;
4677
4678	// Reduction identifier is not in OMP5.2 Table 5.2
4679	default:
4680	DIE("This should have been caught in CheckIntrinsicOperator");
4681	return false;
4682	}
4683	parser::CharBlock name{MakeNameFromOperator(*intrinsicOp, context)};
4684	return CheckSymbolSupportsType(scope, name, type);
4685	} else if (const auto *definedOp{
4686	std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
4687	return CheckSymbolSupportsType(
4688	scope, MangleDefinedOperator(definedOp->v.symbol->name()), type);
4689	}
4690	llvm_unreachable(
4691	"A DefinedOperator is either a DefinedOpName or an IntrinsicOperator");
4692	}};
4693
4694	auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {
4695	const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
4696	CHECK(name && name->symbol);
4697	if (name && name->symbol) {
4698	const SourceName &realName{name->symbol->GetUltimate().name()};
4699	// OMP5.2: The type [...] of a list item that appears in a
4700	// reduction clause must be valid for the combiner expression
4701	if (realName == "iand" || realName == "ior" || realName == "ieor") {
4702	// IAND: arguments must be integers: F2023 16.9.100
4703	// IEOR: arguments must be integers: F2023 16.9.106
4704	// IOR: arguments must be integers: F2023 16.9.111
4705	if (type.IsNumeric(TypeCategory::Integer)) {
4706	return true;
4707	}
4708	} else if (realName == "max" || realName == "min") {
4709	// MAX: arguments must be integer, real, or character:
4710	// F2023 16.9.135
4711	// MIN: arguments must be integer, real, or character:
4712	// F2023 16.9.141
4713	if (type.IsNumeric(TypeCategory::Integer) ||
4714	type.IsNumeric(TypeCategory::Real) || isCharacter(type)) {
4715	return true;
4716	}
4717	}
4718
4719	// If we get here, it may be a user declared reduction, so check
4720	// if the symbol has UserReductionDetails, and if so, the type is
4721	// supported.
4722	if (const auto *reductionDetails{
4723	name->symbol->detailsIf<UserReductionDetails>()}) {
4724	return reductionDetails->SupportsType(type);
4725	}
4726
4727	// We also need to check for mangled names (max, min, iand, ieor and ior)
4728	// and then check if the type is there.
4729	parser::CharBlock mangledName{MangleSpecialFunctions(name->source)};
4730	return CheckSymbolSupportsType(scope, mangledName, type);
4731	}
4732	// Everything else is "not matching type".
4733	return false;
4734	}};
4735
4736	return common::visit(
4737	common::visitors{checkOperator, checkDesignator}, ident.u);
4738	}
4739
4740	void OmpStructureChecker::CheckReductionObjectTypes(
4741	const parser::OmpObjectList &objects,
4742	const parser::OmpReductionIdentifier &ident) {
4743	SymbolSourceMap symbols;
4744	GetSymbolsInObjectList(objects, symbols);
4745
4746	for (auto &[symbol, source] : symbols) {
4747	if (auto *type{symbol->GetType()}) {
4748	const auto &scope{context_.FindScope(symbol->name())};
4749	if (!IsReductionAllowedForType(ident, *type, scope, context_)) {
4750	context_.Say(source,
4751	"The type of '%s' is incompatible with the reduction operator."_err_en_US,
4752	symbol->name());
4753	}
4754	} else {
4755	assert(IsProcedurePointer(*symbol) && "Unexpected symbol properties");
4756	}
4757	}
4758	}
4759
4760	void OmpStructureChecker::CheckReductionModifier(
4761	const parser::OmpReductionModifier &modifier) {
4762	using ReductionModifier = parser::OmpReductionModifier;
4763	if (modifier.v == ReductionModifier::Value::Default) {
4764	// The default one is always ok.
4765	return;
4766	}
4767	const DirectiveContext &dirCtx{GetContext()};
4768	if (dirCtx.directive == llvm::omp::Directive::OMPD_loop ||
4769	dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {
4770	// [5.2:257:33-34]
4771	// If a reduction-modifier is specified in a reduction clause that
4772	// appears on the directive, then the reduction modifier must be
4773	// default.
4774	// [5.2:268:16]
4775	// The reduction-modifier must be default.
4776	context_.Say(GetContext().clauseSource,
4777	"REDUCTION modifier on %s directive must be DEFAULT"_err_en_US,
4778	parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
4779	return;
4780	}
4781	if (modifier.v == ReductionModifier::Value::Task) {
4782	// "Task" is only allowed on worksharing or "parallel" directive.
4783	static llvm::omp::Directive worksharing[]{
4784	llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_scope,
4785	llvm::omp::Directive::OMPD_sections,
4786	// There are more worksharing directives, but they do not apply:
4787	// "for" is C++ only,
4788	// "single" and "workshare" don't allow reduction clause,
4789	// "loop" has different restrictions (checked above).
4790	};
4791	if (dirCtx.directive != llvm::omp::Directive::OMPD_parallel &&
4792	!llvm::is_contained(worksharing, dirCtx.directive)) {
4793	context_.Say(GetContext().clauseSource,
4794	"Modifier 'TASK' on REDUCTION clause is only allowed with "
4795	"PARALLEL or worksharing directive"_err_en_US);
4796	}
4797	} else if (modifier.v == ReductionModifier::Value::Inscan) {
4798	// "Inscan" is only allowed on worksharing-loop, worksharing-loop simd,
4799	// or "simd" directive.
4800	// The worksharing-loop directives are OMPD_do and OMPD_for. Only the
4801	// former is allowed in Fortran.
4802	if (!llvm::omp::scanParentAllowedSet.test(dirCtx.directive)) {
4803	context_.Say(GetContext().clauseSource,
4804	"Modifier 'INSCAN' on REDUCTION clause is only allowed with "
4805	"WORKSHARING LOOP, WORKSHARING LOOP SIMD, "
4806	"or SIMD directive"_err_en_US);
4807	}
4808	} else {
4809	// Catch-all for potential future modifiers to make sure that this
4810	// function is up-to-date.
4811	context_.Say(GetContext().clauseSource,
4812	"Unexpected modifier on REDUCTION clause"_err_en_US);
4813	}
4814	}
4815
4816	void OmpStructureChecker::CheckReductionArraySection(
4817	const parser::OmpObjectList &ompObjectList, llvm::omp::Clause clauseId) {
4818	for (const auto &ompObject : ompObjectList.v) {
4819	if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
4820	if (const auto *arrayElement{
4821	parser::Unwrap<parser::ArrayElement>(ompObject)}) {
4822	CheckArraySection(*arrayElement, GetLastName(*dataRef), clauseId);
4823	}
4824	}
4825	}
4826	}
4827
4828	void OmpStructureChecker::CheckSharedBindingInOuterContext(
4829	const parser::OmpObjectList &redObjectList) {
4830	// TODO: Verify the assumption here that the immediately enclosing region is
4831	// the parallel region to which the worksharing construct having reduction
4832	// binds to.
4833	if (auto *enclosingContext{GetEnclosingDirContext()}) {
4834	for (auto it : enclosingContext->clauseInfo) {
4835	llvmOmpClause type = it.first;
4836	const auto *clause = it.second;
4837	if (llvm::omp::privateReductionSet.test(type)) {
4838	if (const auto *objList{GetOmpObjectList(*clause)}) {
4839	for (const auto &ompObject : objList->v) {
4840	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
4841	if (const auto *symbol{name->symbol}) {
4842	for (const auto &redOmpObject : redObjectList.v) {
4843	if (const auto *rname{
4844	parser::Unwrap<parser::Name>(redOmpObject)}) {
4845	if (const auto *rsymbol{rname->symbol}) {
4846	if (rsymbol->name() == symbol->name()) {
4847	context_.Say(GetContext().clauseSource,
4848	"%s variable '%s' is %s in outer context must"
4849	" be shared in the parallel regions to which any"
4850	" of the worksharing regions arising from the "
4851	"worksharing construct bind."_err_en_US,
4852	parser::ToUpperCaseLetters(
4853	getClauseName(llvm::omp::Clause::OMPC_reduction)
4854	.str()),
4855	symbol->name(),
4856	parser::ToUpperCaseLetters(
4857	getClauseName(type).str()));
4858	}
4859	}
4860	}
4861	}
4862	}
4863	}
4864	}
4865	}
4866	}
4867	}
4868	}
4869	}
4870
4871	void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
4872	CheckAllowedClause(llvm::omp::Clause::OMPC_ordered);
4873	// the parameter of ordered clause is optional
4874	if (const auto &expr{x.v}) {
4875	RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
4876	// 2.8.3 Loop SIMD Construct Restriction
4877	if (llvm::omp::allDoSimdSet.test(GetContext().directive)) {
4878	context_.Say(GetContext().clauseSource,
4879	"No ORDERED clause with a parameter can be specified "
4880	"on the %s directive"_err_en_US,
4881	ContextDirectiveAsFortran());
4882	}
4883	}
4884	}
4885
4886	void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
4887	CheckAllowedClause(llvm::omp::Clause::OMPC_shared);
4888	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "SHARED");
4889	CheckCrayPointee(x.v, "SHARED");
4890	}
4891	void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
4892	SymbolSourceMap symbols;
4893	GetSymbolsInObjectList(x.v, symbols);
4894	CheckAllowedClause(llvm::omp::Clause::OMPC_private);
4895	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "PRIVATE");
4896	CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_private);
4897	CheckCrayPointee(x.v, "PRIVATE");
4898	}
4899
4900	void OmpStructureChecker::Enter(const parser::OmpClause::Nowait &x) {
4901	CheckAllowedClause(llvm::omp::Clause::OMPC_nowait);
4902	}
4903
4904	bool OmpStructureChecker::IsDataRefTypeParamInquiry(
4905	const parser::DataRef *dataRef) {
4906	bool dataRefIsTypeParamInquiry{false};
4907	if (const auto *structComp{
4908	parser::Unwrap<parser::StructureComponent>(dataRef)}) {
4909	if (const auto *compSymbol{structComp->component.symbol}) {
4910	if (const auto *compSymbolMiscDetails{
4911	std::get_if<MiscDetails>(&compSymbol->details())}) {
4912	const auto detailsKind = compSymbolMiscDetails->kind();
4913	dataRefIsTypeParamInquiry =
4914	(detailsKind == MiscDetails::Kind::KindParamInquiry ||
4915	detailsKind == MiscDetails::Kind::LenParamInquiry);
4916	} else if (compSymbol->has<TypeParamDetails>()) {
4917	dataRefIsTypeParamInquiry = true;
4918	}
4919	}
4920	}
4921	return dataRefIsTypeParamInquiry;
4922	}
4923
4924	void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
4925	const parser::CharBlock &source, const parser::OmpObjectList &objList,
4926	llvm::StringRef clause) {
4927	for (const auto &ompObject : objList.v) {
4928	CheckVarIsNotPartOfAnotherVar(source, ompObject, clause);
4929	}
4930	}
4931
4932	void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
4933	const parser::CharBlock &source, const parser::OmpObject &ompObject,
4934	llvm::StringRef clause) {
4935	common::visit(
4936	common::visitors{
4937	[&](const parser::Designator &designator) {
4938	if (const auto *dataRef{
4939	std::get_if<parser::DataRef>(&designator.u)}) {
4940	if (IsDataRefTypeParamInquiry(dataRef)) {
4941	context_.Say(source,
4942	"A type parameter inquiry cannot appear on the %s directive"_err_en_US,
4943	ContextDirectiveAsFortran());
4944	} else if (parser::Unwrap<parser::StructureComponent>(
4945	ompObject) ||
4946	parser::Unwrap<parser::ArrayElement>(ompObject)) {
4947	if (llvm::omp::nonPartialVarSet.test(GetContext().directive)) {
4948	context_.Say(source,
4949	"A variable that is part of another variable (as an array or structure element) cannot appear on the %s directive"_err_en_US,
4950	ContextDirectiveAsFortran());
4951	} else {
4952	context_.Say(source,
4953	"A variable that is part of another variable (as an array or structure element) cannot appear in a %s clause"_err_en_US,
4954	clause.data());
4955	}
4956	}
4957	}
4958	},
4959	[&](const parser::Name &name) {},
4960	},
4961	ompObject.u);
4962	}
4963
4964	void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
4965	CheckAllowedClause(llvm::omp::Clause::OMPC_firstprivate);
4966
4967	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "FIRSTPRIVATE");
4968	CheckCrayPointee(x.v, "FIRSTPRIVATE");
4969	CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
4970
4971	SymbolSourceMap currSymbols;
4972	GetSymbolsInObjectList(x.v, currSymbols);
4973	CheckCopyingPolymorphicAllocatable(
4974	currSymbols, llvm::omp::Clause::OMPC_firstprivate);
4975
4976	DirectivesClauseTriple dirClauseTriple;
4977	// Check firstprivate variables in worksharing constructs
4978	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
4979	std::make_pair(
4980	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
4981	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
4982	std::make_pair(
4983	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
4984	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
4985	std::make_pair(
4986	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
4987	// Check firstprivate variables in distribute construct
4988	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
4989	std::make_pair(
4990	llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
4991	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
4992	std::make_pair(llvm::omp::Directive::OMPD_target_teams,
4993	llvm::omp::privateReductionSet));
4994	// Check firstprivate variables in task and taskloop constructs
4995	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
4996	std::make_pair(llvm::omp::Directive::OMPD_parallel,
4997	OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
4998	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
4999	std::make_pair(llvm::omp::Directive::OMPD_parallel,
5000	OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
5001
5002	CheckPrivateSymbolsInOuterCxt(
5003	currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
5004	}
5005
5006	void OmpStructureChecker::CheckIsLoopIvPartOfClause(
5007	llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
5008	for (const auto &ompObject : ompObjectList.v) {
5009	if (const parser::Name *name{parser::Unwrap<parser::Name>(ompObject)}) {
5010	if (name->symbol == GetContext().loopIV) {
5011	context_.Say(name->source,
5012	"DO iteration variable %s is not allowed in %s clause."_err_en_US,
5013	name->ToString(),
5014	parser::ToUpperCaseLetters(getClauseName(clause).str()));
5015	}
5016	}
5017	}
5018	}
5019
5020	// Restrictions specific to each clause are implemented apart from the
5021	// generalized restrictions.
5022	void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
5023	CheckAllowedClause(llvm::omp::Clause::OMPC_aligned);
5024	if (OmpVerifyModifiers(
5025	x.v, llvm::omp::OMPC_aligned, GetContext().clauseSource, context_)) {
5026	auto &modifiers{OmpGetModifiers(x.v)};
5027	if (auto *align{OmpGetUniqueModifier<parser::OmpAlignment>(modifiers)}) {
5028	if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
5029	context_.Say(OmpGetModifierSource(modifiers, align),
5030	"The alignment value should be a constant positive integer"_err_en_US);
5031	}
5032	}
5033	}
5034	// 2.8.1 TODO: list-item attribute check
5035	}
5036
5037	void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
5038	CheckAllowedClause(llvm::omp::Clause::OMPC_defaultmap);
5039	unsigned version{context_.langOptions().OpenMPVersion};
5040	using ImplicitBehavior = parser::OmpDefaultmapClause::ImplicitBehavior;
5041	auto behavior{std::get<ImplicitBehavior>(x.v.t)};
5042	if (version <= 45) {
5043	if (behavior != ImplicitBehavior::Tofrom) {
5044	context_.Say(GetContext().clauseSource,
5045	"%s is not allowed in %s, %s"_warn_en_US,
5046	parser::ToUpperCaseLetters(
5047	parser::OmpDefaultmapClause::EnumToString(behavior)),
5048	ThisVersion(version), TryVersion(50));
5049	}
5050	}
5051	if (!OmpVerifyModifiers(x.v, llvm::omp::OMPC_defaultmap,
5052	GetContext().clauseSource, context_)) {
5053	// If modifier verification fails, return early.
5054	return;
5055	}
5056	auto &modifiers{OmpGetModifiers(x.v)};
5057	auto *maybeCategory{
5058	OmpGetUniqueModifier<parser::OmpVariableCategory>(modifiers)};
5059	if (maybeCategory) {
5060	using VariableCategory = parser::OmpVariableCategory;
5061	VariableCategory::Value category{maybeCategory->v};
5062	unsigned tryVersion{0};
5063	if (version <= 45 && category != VariableCategory::Value::Scalar) {
5064	tryVersion = 50;
5065	}
5066	if (version < 52 && category == VariableCategory::Value::All) {
5067	tryVersion = 52;
5068	}
5069	if (tryVersion) {
5070	context_.Say(GetContext().clauseSource,
5071	"%s is not allowed in %s, %s"_warn_en_US,
5072	parser::ToUpperCaseLetters(VariableCategory::EnumToString(category)),
5073	ThisVersion(version), TryVersion(tryVersion));
5074	}
5075	}
5076	}
5077
5078	void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
5079	CheckAllowedClause(llvm::omp::Clause::OMPC_if);
5080	unsigned version{context_.langOptions().OpenMPVersion};
5081	llvm::omp::Directive dir{GetContext().directive};
5082
5083	auto isConstituent{[](llvm::omp::Directive dir, llvm::omp::Directive part) {
5084	using namespace llvm::omp;
5085	llvm::ArrayRef<Directive> dirLeafs{getLeafConstructsOrSelf(dir)};
5086	llvm::ArrayRef<Directive> partLeafs{getLeafConstructsOrSelf(part)};
5087	// Maybe it's sufficient to check if every leaf of `part` is also a leaf
5088	// of `dir`, but to be safe check if `partLeafs` is a sub-sequence of
5089	// `dirLeafs`.
5090	size_t dirSize{dirLeafs.size()}, partSize{partLeafs.size()};
5091	// Find the first leaf from `part` in `dir`.
5092	if (auto first = llvm::find(dirLeafs, partLeafs.front());
5093	first != dirLeafs.end()) {
5094	// A leaf can only appear once in a compound directive, so if `part`
5095	// is a subsequence of `dir`, it must start here.
5096	size_t firstPos{
5097	static_cast<size_t>(std::distance(dirLeafs.begin(), first))};
5098	llvm::ArrayRef<Directive> subSeq{
5099	first, std::min<size_t>(dirSize - firstPos, partSize)};
5100	return subSeq == partLeafs;
5101	}
5102	return false;
5103	}};
5104
5105	if (OmpVerifyModifiers(
5106	x.v, llvm::omp::OMPC_if, GetContext().clauseSource, context_)) {
5107	auto &modifiers{OmpGetModifiers(x.v)};
5108	if (auto *dnm{OmpGetUniqueModifier<parser::OmpDirectiveNameModifier>(
5109	modifiers)}) {
5110	llvm::omp::Directive sub{dnm->v};
5111	std::string subName{
5112	parser::ToUpperCaseLetters(getDirectiveName(sub).str())};
5113	std::string dirName{
5114	parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
5115
5116	parser::CharBlock modifierSource{OmpGetModifierSource(modifiers, dnm)};
5117	auto desc{OmpGetDescriptor<parser::OmpDirectiveNameModifier>()};
5118	std::string modName{desc.name.str()};
5119
5120	if (!isConstituent(dir, sub)) {
5121	context_
5122	.Say(modifierSource,
5123	"%s is not a constituent of the %s directive"_err_en_US,
5124	subName, dirName)
5125	.Attach(GetContext().directiveSource,
5126	"Cannot apply to directive"_en_US);
5127	} else {
5128	static llvm::omp::Directive valid45[]{
5129	llvm::omp::OMPD_cancel, //
5130	llvm::omp::OMPD_parallel, //
5131	/* OMP 5.0+ also allows OMPD_simd */
5132	llvm::omp::OMPD_target, //
5133	llvm::omp::OMPD_target_data, //
5134	llvm::omp::OMPD_target_enter_data, //
5135	llvm::omp::OMPD_target_exit_data, //
5136	llvm::omp::OMPD_target_update, //
5137	llvm::omp::OMPD_task, //
5138	llvm::omp::OMPD_taskloop, //
5139	/* OMP 5.2+ also allows OMPD_teams */
5140	};
5141	if (version < 50 && sub == llvm::omp::OMPD_simd) {
5142	context_.Say(modifierSource,
5143	"%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,
5144	modName, ThisVersion(version), TryVersion(50));
5145	} else if (version < 52 && sub == llvm::omp::OMPD_teams) {
5146	context_.Say(modifierSource,
5147	"%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,
5148	modName, ThisVersion(version), TryVersion(52));
5149	} else if (!llvm::is_contained(valid45, sub) &&
5150	sub != llvm::omp::OMPD_simd && sub != llvm::omp::OMPD_teams) {
5151	context_.Say(modifierSource,
5152	"%s is not allowed as '%s' in %s"_err_en_US, subName, modName,
5153	ThisVersion(version));
5154	}
5155	}
5156	}
5157	}
5158	}
5159
5160	void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) {
5161	CheckAllowedClause(llvm::omp::Clause::OMPC_linear);
5162	unsigned version{context_.langOptions().OpenMPVersion};
5163	llvm::omp::Directive dir{GetContext().directive};
5164	parser::CharBlock clauseSource{GetContext().clauseSource};
5165	const parser::OmpLinearModifier *linearMod{nullptr};
5166
5167	SymbolSourceMap symbols;
5168	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
5169	CheckCrayPointee(objects, "LINEAR", false);
5170	GetSymbolsInObjectList(objects, symbols);
5171
5172	auto CheckIntegerNoRef{[&](const Symbol *symbol, parser::CharBlock source) {
5173	if (!symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
5174	auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
5175	context_.Say(source,
5176	"The list item '%s' specified without the REF '%s' must be of INTEGER type"_err_en_US,
5177	symbol->name(), desc.name.str());
5178	}
5179	}};
5180
5181	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_linear, clauseSource, context_)) {
5182	auto &modifiers{OmpGetModifiers(x.v)};
5183	linearMod = OmpGetUniqueModifier<parser::OmpLinearModifier>(modifiers);
5184	if (linearMod) {
5185	// 2.7 Loop Construct Restriction
5186	if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(dir)) {
5187	context_.Say(clauseSource,
5188	"A modifier may not be specified in a LINEAR clause on the %s directive"_err_en_US,
5189	ContextDirectiveAsFortran());
5190	return;
5191	}
5192
5193	auto &desc{OmpGetDescriptor<parser::OmpLinearModifier>()};
5194	for (auto &[symbol, source] : symbols) {
5195	if (linearMod->v != parser::OmpLinearModifier::Value::Ref) {
5196	CheckIntegerNoRef(symbol, source);
5197	} else {
5198	if (!IsAllocatable(*symbol) && !IsAssumedShape(*symbol) &&
5199	!IsPolymorphic(*symbol)) {
5200	context_.Say(source,
5201	"The list item `%s` specified with the REF '%s' must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US,
5202	symbol->name(), desc.name.str());
5203	}
5204	}
5205	if (linearMod->v == parser::OmpLinearModifier::Value::Ref ||
5206	linearMod->v == parser::OmpLinearModifier::Value::Uval) {
5207	if (!IsDummy(*symbol) || IsValue(*symbol)) {
5208	context_.Say(source,
5209	"If the `%s` is REF or UVAL, the list item '%s' must be a dummy argument without the VALUE attribute"_err_en_US,
5210	desc.name.str(), symbol->name());
5211	}
5212	}
5213	} // for (symbol, source)
5214
5215	if (version >= 52 && !std::get</*PostModified=*/bool>(x.v.t)) {
5216	context_.Say(OmpGetModifierSource(modifiers, linearMod),
5217	"The 'modifier(<list>)' syntax is deprecated in %s, use '<list> : modifier' instead"_warn_en_US,
5218	ThisVersion(version));
5219	}
5220	}
5221	}
5222
5223	// OpenMP 5.2: Ordered clause restriction
5224	if (const auto *clause{
5225	FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) {
5226	const auto &orderedClause{std::get<parser::OmpClause::Ordered>(clause->u)};
5227	if (orderedClause.v) {
5228	return;
5229	}
5230	}
5231
5232	// OpenMP 5.2: Linear clause Restrictions
5233	for (auto &[symbol, source] : symbols) {
5234	if (!linearMod) {
5235	// Already checked this with the modifier present.
5236	CheckIntegerNoRef(symbol, source);
5237	}
5238	if (dir == llvm::omp::Directive::OMPD_declare_simd && !IsDummy(*symbol)) {
5239	context_.Say(source,
5240	"The list item `%s` must be a dummy argument"_err_en_US,
5241	symbol->name());
5242	}
5243	if (IsPointer(*symbol) || symbol->test(Symbol::Flag::CrayPointer)) {
5244	context_.Say(source,
5245	"The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US,
5246	symbol->name());
5247	}
5248	if (FindCommonBlockContaining(*symbol)) {
5249	context_.Say(source,
5250	"'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US,
5251	symbol->name());
5252	}
5253	}
5254	}
5255
5256	void OmpStructureChecker::Enter(const parser::OmpClause::Detach &x) {
5257	unsigned version{context_.langOptions().OpenMPVersion};
5258	if (version >= 52) {
5259	SetContextClauseInfo(llvm::omp::Clause::OMPC_detach);
5260	} else {
5261	// OpenMP 5.0: 2.10.1 Task construct restrictions
5262	CheckAllowedClause(llvm::omp::Clause::OMPC_detach);
5263	}
5264	// OpenMP 5.2: 12.5.2 Detach clause restrictions
5265	if (version >= 52) {
5266	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v.v, "DETACH");
5267	}
5268
5269	if (const auto *name{parser::Unwrap<parser::Name>(x.v.v)}) {
5270	if (version >= 52 && IsPointer(*name->symbol)) {
5271	context_.Say(GetContext().clauseSource,
5272	"The event-handle: `%s` must not have the POINTER attribute"_err_en_US,
5273	name->ToString());
5274	}
5275	if (!name->symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
5276	context_.Say(GetContext().clauseSource,
5277	"The event-handle: `%s` must be of type integer(kind=omp_event_handle_kind)"_err_en_US,
5278	name->ToString());
5279	}
5280	}
5281	}
5282
5283	void OmpStructureChecker::CheckAllowedMapTypes(
5284	const parser::OmpMapType::Value &type,
5285	const std::list<parser::OmpMapType::Value> &allowedMapTypeList) {
5286	if (!llvm::is_contained(allowedMapTypeList, type)) {
5287	std::string commaSeparatedMapTypes;
5288	llvm::interleave(
5289	allowedMapTypeList.begin(), allowedMapTypeList.end(),
5290	[&](const parser::OmpMapType::Value &mapType) {
5291	commaSeparatedMapTypes.append(parser::ToUpperCaseLetters(
5292	parser::OmpMapType::EnumToString(mapType)));
5293	},
5294	[&] { commaSeparatedMapTypes.append(s: ", "); });
5295	context_.Say(GetContext().clauseSource,
5296	"Only the %s map types are permitted "
5297	"for MAP clauses on the %s directive"_err_en_US,
5298	commaSeparatedMapTypes, ContextDirectiveAsFortran());
5299	}
5300	}
5301
5302	void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
5303	CheckAllowedClause(llvm::omp::Clause::OMPC_map);
5304	if (!OmpVerifyModifiers(
5305	x.v, llvm::omp::OMPC_map, GetContext().clauseSource, context_)) {
5306	return;
5307	}
5308
5309	auto &modifiers{OmpGetModifiers(x.v)};
5310	unsigned version{context_.langOptions().OpenMPVersion};
5311	if (auto commas{std::get<bool>(x.v.t)}; !commas && version >= 52) {
5312	context_.Say(GetContext().clauseSource,
5313	"The specification of modifiers without comma separators for the "
5314	"'MAP' clause has been deprecated in OpenMP 5.2"_port_en_US);
5315	}
5316	if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
5317	CheckIteratorModifier(*iter);
5318	}
5319	if (auto *type{OmpGetUniqueModifier<parser::OmpMapType>(modifiers)}) {
5320	using Value = parser::OmpMapType::Value;
5321	switch (GetContext().directive) {
5322	case llvm::omp::Directive::OMPD_target:
5323	case llvm::omp::Directive::OMPD_target_teams:
5324	case llvm::omp::Directive::OMPD_target_teams_distribute:
5325	case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
5326	case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
5327	case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
5328	case llvm::omp::Directive::OMPD_target_data:
5329	CheckAllowedMapTypes(
5330	type->v, {Value::To, Value::From, Value::Tofrom, Value::Alloc});
5331	break;
5332	case llvm::omp::Directive::OMPD_target_enter_data:
5333	CheckAllowedMapTypes(type->v, {Value::To, Value::Alloc});
5334	break;
5335	case llvm::omp::Directive::OMPD_target_exit_data:
5336	CheckAllowedMapTypes(
5337	type->v, {Value::From, Value::Release, Value::Delete});
5338	break;
5339	default:
5340	break;
5341	}
5342	}
5343
5344	auto &&typeMods{
5345	OmpGetRepeatableModifier<parser::OmpMapTypeModifier>(modifiers)};
5346	struct Less {
5347	using Iterator = decltype(typeMods.begin());
5348	bool operator()(Iterator a, Iterator b) const {
5349	const parser::OmpMapTypeModifier *pa = *a;
5350	const parser::OmpMapTypeModifier *pb = *b;
5351	return pa->v < pb->v;
5352	}
5353	};
5354	if (auto maybeIter{FindDuplicate<Less>(typeMods)}) {
5355	context_.Say(GetContext().clauseSource,
5356	"Duplicate map-type-modifier entry '%s' will be ignored"_warn_en_US,
5357	parser::ToUpperCaseLetters(
5358	parser::OmpMapTypeModifier::EnumToString((**maybeIter)->v)));
5359	}
5360	}
5361
5362	void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
5363	CheckAllowedClause(llvm::omp::Clause::OMPC_schedule);
5364	const parser::OmpScheduleClause &scheduleClause = x.v;
5365	if (!OmpVerifyModifiers(scheduleClause, llvm::omp::OMPC_schedule,
5366	GetContext().clauseSource, context_)) {
5367	return;
5368	}
5369
5370	// 2.7 Loop Construct Restriction
5371	if (llvm::omp::allDoSet.test(GetContext().directive)) {
5372	auto &modifiers{OmpGetModifiers(scheduleClause)};
5373	auto kind{std::get<parser::OmpScheduleClause::Kind>(scheduleClause.t)};
5374	auto &chunk{
5375	std::get<std::optional<parser::ScalarIntExpr>>(scheduleClause.t)};
5376	if (chunk) {
5377	if (kind == parser::OmpScheduleClause::Kind::Runtime ||
5378	kind == parser::OmpScheduleClause::Kind::Auto) {
5379	context_.Say(GetContext().clauseSource,
5380	"When SCHEDULE clause has %s specified, "
5381	"it must not have chunk size specified"_err_en_US,
5382	parser::ToUpperCaseLetters(
5383	parser::OmpScheduleClause::EnumToString(kind)));
5384	}
5385	if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
5386	scheduleClause.t)}) {
5387	RequiresPositiveParameter(
5388	llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
5389	}
5390	}
5391
5392	auto *ordering{
5393	OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};
5394	if (ordering &&
5395	ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {
5396	if (kind != parser::OmpScheduleClause::Kind::Dynamic &&
5397	kind != parser::OmpScheduleClause::Kind::Guided) {
5398	context_.Say(GetContext().clauseSource,
5399	"The NONMONOTONIC modifier can only be specified with "
5400	"SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
5401	}
5402	}
5403	}
5404	}
5405
5406	void OmpStructureChecker::Enter(const parser::OmpClause::Device &x) {
5407	CheckAllowedClause(llvm::omp::Clause::OMPC_device);
5408	const parser::OmpDeviceClause &deviceClause{x.v};
5409	const auto &device{std::get<parser::ScalarIntExpr>(deviceClause.t)};
5410	RequiresPositiveParameter(
5411	llvm::omp::Clause::OMPC_device, device, "device expression");
5412	llvm::omp::Directive dir{GetContext().directive};
5413
5414	if (OmpVerifyModifiers(deviceClause, llvm::omp::OMPC_device,
5415	GetContext().clauseSource, context_)) {
5416	auto &modifiers{OmpGetModifiers(deviceClause)};
5417
5418	if (auto *deviceMod{
5419	OmpGetUniqueModifier<parser::OmpDeviceModifier>(modifiers)}) {
5420	using Value = parser::OmpDeviceModifier::Value;
5421	if (dir != llvm::omp::OMPD_target && deviceMod->v == Value::Ancestor) {
5422	auto name{OmpGetDescriptor<parser::OmpDeviceModifier>().name};
5423	context_.Say(OmpGetModifierSource(modifiers, deviceMod),
5424	"The ANCESTOR %s must not appear on the DEVICE clause on any directive other than the TARGET construct. Found on %s construct."_err_en_US,
5425	name.str(), parser::ToUpperCaseLetters(getDirectiveName(dir)));
5426	}
5427	}
5428	}
5429	}
5430
5431	void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
5432	CheckAllowedClause(llvm::omp::Clause::OMPC_depend);
5433	llvm::omp::Directive dir{GetContext().directive};
5434	unsigned version{context_.langOptions().OpenMPVersion};
5435
5436	auto *doaDep{std::get_if<parser::OmpDoacross>(&x.v.u)};
5437	auto *taskDep{std::get_if<parser::OmpDependClause::TaskDep>(&x.v.u)};
5438	assert(((doaDep == nullptr) != (taskDep == nullptr)) &&
5439	"Unexpected alternative in update clause");
5440
5441	if (doaDep) {
5442	CheckDoacross(*doaDep);
5443	CheckDependenceType(doaDep->GetDepType());
5444	} else {
5445	using Modifier = parser::OmpDependClause::TaskDep::Modifier;
5446	auto &modifiers{std::get<std::optional<std::list<Modifier>>>(taskDep->t)};
5447	if (!modifiers) {
5448	context_.Say(GetContext().clauseSource,
5449	"A DEPEND clause on a TASK construct must have a valid task dependence type"_err_en_US);
5450	return;
5451	}
5452	CheckTaskDependenceType(taskDep->GetTaskDepType());
5453	}
5454
5455	if (dir == llvm::omp::OMPD_depobj) {
5456	// [5.0:255:11], [5.1:288:3]
5457	// A depend clause on a depobj construct must not have source, sink [or
5458	// depobj](5.0) as dependence-type.
5459	if (version >= 50) {
5460	bool invalidDep{false};
5461	if (taskDep) {
5462	if (version == 50) {
5463	invalidDep = taskDep->GetTaskDepType() ==
5464	parser::OmpTaskDependenceType::Value::Depobj;
5465	}
5466	} else {
5467	invalidDep = true;
5468	}
5469	if (invalidDep) {
5470	context_.Say(GetContext().clauseSource,
5471	"A DEPEND clause on a DEPOBJ construct must not have %s as dependence type"_err_en_US,
5472	version == 50 ? "SINK, SOURCE or DEPOBJ" : "SINK or SOURCE");
5473	}
5474	}
5475	} else if (dir != llvm::omp::OMPD_ordered) {
5476	if (doaDep) {
5477	context_.Say(GetContext().clauseSource,
5478	"The SINK and SOURCE dependence types can only be used with the ORDERED directive, used here in the %s construct"_err_en_US,
5479	parser::ToUpperCaseLetters(getDirectiveName(dir)));
5480	}
5481	}
5482	if (taskDep) {
5483	auto &objList{std::get<parser::OmpObjectList>(taskDep->t)};
5484	if (dir == llvm::omp::OMPD_depobj) {
5485	// [5.0:255:13], [5.1:288:6], [5.2:322:26]
5486	// A depend clause on a depobj construct must only specify one locator.
5487	if (objList.v.size() != 1) {
5488	context_.Say(GetContext().clauseSource,
5489	"A DEPEND clause on a DEPOBJ construct must only specify "
5490	"one locator"_err_en_US);
5491	}
5492	}
5493	for (const auto &object : objList.v) {
5494	if (const auto *name{std::get_if<parser::Name>(&object.u)}) {
5495	context_.Say(GetContext().clauseSource,
5496	"Common block name ('%s') cannot appear in a DEPEND "
5497	"clause"_err_en_US,
5498	name->ToString());
5499	} else if (auto *designator{std::get_if<parser::Designator>(&object.u)}) {
5500	if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
5501	CheckDependList(*dataRef);
5502	if (const auto *arr{
5503	std::get_if<common::Indirection<parser::ArrayElement>>(
5504	&dataRef->u)}) {
5505	CheckArraySection(arr->value(), GetLastName(*dataRef),
5506	llvm::omp::Clause::OMPC_depend);
5507	}
5508	}
5509	}
5510	}
5511	if (OmpVerifyModifiers(*taskDep, llvm::omp::OMPC_depend,
5512	GetContext().clauseSource, context_)) {
5513	auto &modifiers{OmpGetModifiers(*taskDep)};
5514	if (OmpGetUniqueModifier<parser::OmpIterator>(modifiers)) {
5515	if (dir == llvm::omp::OMPD_depobj) {
5516	context_.Say(GetContext().clauseSource,
5517	"An iterator-modifier may specify multiple locators, a DEPEND clause on a DEPOBJ construct must only specify one locator"_warn_en_US);
5518	}
5519	}
5520	}
5521	}
5522	}
5523
5524	void OmpStructureChecker::Enter(const parser::OmpClause::Doacross &x) {
5525	CheckAllowedClause(llvm::omp::Clause::OMPC_doacross);
5526	CheckDoacross(x.v.v);
5527	}
5528
5529	void OmpStructureChecker::CheckDoacross(const parser::OmpDoacross &doa) {
5530	if (std::holds_alternative<parser::OmpDoacross::Source>(doa.u)) {
5531	// Nothing to check here.
5532	return;
5533	}
5534
5535	// Process SINK dependence type. SINK may only appear in an ORDER construct,
5536	// which references a prior ORDERED(n) clause on a DO or SIMD construct
5537	// that marks the top of the loop nest.
5538
5539	auto &sink{std::get<parser::OmpDoacross::Sink>(doa.u)};
5540	const std::list<parser::OmpIteration> &vec{sink.v.v};
5541
5542	// Check if the variables in the iteration vector are unique.
5543	struct Less {
5544	using Iterator = std::list<parser::OmpIteration>::const_iterator;
5545	bool operator()(Iterator a, Iterator b) const {
5546	auto namea{std::get<parser::Name>(a->t)};
5547	auto nameb{std::get<parser::Name>(b->t)};
5548	assert(namea.symbol && nameb.symbol && "Unresolved symbols");
5549	// The non-determinism of the "<" doesn't matter, we only care about
5550	// equality, i.e. a == b <=> !(a < b) && !(b < a)
5551	return reinterpret_cast<uintptr_t>(namea.symbol) <
5552	reinterpret_cast<uintptr_t>(nameb.symbol);
5553	}
5554	};
5555	if (auto maybeIter{FindDuplicate<Less>(vec)}) {
5556	auto name{std::get<parser::Name>((*maybeIter)->t)};
5557	context_.Say(name.source,
5558	"Duplicate variable '%s' in the iteration vector"_err_en_US,
5559	name.ToString());
5560	}
5561
5562	// Check if the variables in the iteration vector are induction variables.
5563	// Ignore any mismatch between the size of the iteration vector and the
5564	// number of DO constructs on the stack. This is checked elsewhere.
5565
5566	auto GetLoopDirective{[](const parser::OpenMPLoopConstruct &x) {
5567	auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
5568	return std::get<parser::OmpLoopDirective>(begin.t).v;
5569	}};
5570	auto GetLoopClauses{[](const parser::OpenMPLoopConstruct &x)
5571	-> const std::list<parser::OmpClause> & {
5572	auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
5573	return std::get<parser::OmpClauseList>(begin.t).v;
5574	}};
5575
5576	std::set<const Symbol *> inductionVars;
5577	for (const LoopConstruct &loop : llvm::reverse(loopStack_)) {
5578	if (auto *doc{std::get_if<const parser::DoConstruct *>(&loop)}) {
5579	// Do-construct, collect the induction variable.
5580	if (auto &control{(*doc)->GetLoopControl()}) {
5581	if (auto *b{std::get_if<parser::LoopControl::Bounds>(&control->u)}) {
5582	inductionVars.insert(b->name.thing.symbol);
5583	}
5584	}
5585	} else {
5586	// Omp-loop-construct, check if it's do/simd with an ORDERED clause.
5587	auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&loop)};
5588	assert(loopc && "Expecting OpenMPLoopConstruct");
5589	llvm::omp::Directive loopDir{GetLoopDirective(**loopc)};
5590	if (loopDir == llvm::omp::OMPD_do || loopDir == llvm::omp::OMPD_simd) {
5591	auto IsOrdered{[](const parser::OmpClause &c) {
5592	return c.Id() == llvm::omp::OMPC_ordered;
5593	}};
5594	// If it has ORDERED clause, stop the traversal.
5595	if (llvm::any_of(GetLoopClauses(**loopc), IsOrdered)) {
5596	break;
5597	}
5598	}
5599	}
5600	}
5601	for (const parser::OmpIteration &iter : vec) {
5602	auto &name{std::get<parser::Name>(iter.t)};
5603	if (!inductionVars.count(name.symbol)) {
5604	context_.Say(name.source,
5605	"The iteration vector element '%s' is not an induction variable within the ORDERED loop nest"_err_en_US,
5606	name.ToString());
5607	}
5608	}
5609	}
5610
5611	void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
5612	SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
5613	if (context_.ShouldWarn(common::UsageWarning::Portability)) {
5614	for (auto &[symbol, source] : symbols) {
5615	if (IsPolymorphicAllocatable(*symbol)) {
5616	context_.Warn(common::UsageWarning::Portability, source,
5617	"If a polymorphic variable with allocatable attribute '%s' is in %s clause, the behavior is unspecified"_port_en_US,
5618	symbol->name(),
5619	parser::ToUpperCaseLetters(getClauseName(clause).str()));
5620	}
5621	}
5622	}
5623	}
5624
5625	void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
5626	CheckAllowedClause(llvm::omp::Clause::OMPC_copyprivate);
5627	SymbolSourceMap symbols;
5628	GetSymbolsInObjectList(x.v, symbols);
5629	CheckVariableListItem(symbols);
5630	CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_copyprivate);
5631	CheckCopyingPolymorphicAllocatable(
5632	symbols, llvm::omp::Clause::OMPC_copyprivate);
5633	}
5634
5635	void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
5636	CheckAllowedClause(llvm::omp::Clause::OMPC_lastprivate);
5637
5638	const auto &objectList{std::get<parser::OmpObjectList>(x.v.t)};
5639	CheckVarIsNotPartOfAnotherVar(
5640	GetContext().clauseSource, objectList, "LASTPRIVATE");
5641	CheckCrayPointee(objectList, "LASTPRIVATE");
5642
5643	DirectivesClauseTriple dirClauseTriple;
5644	SymbolSourceMap currSymbols;
5645	GetSymbolsInObjectList(objectList, currSymbols);
5646	CheckDefinableObjects(currSymbols, llvm::omp::Clause::OMPC_lastprivate);
5647	CheckCopyingPolymorphicAllocatable(
5648	currSymbols, llvm::omp::Clause::OMPC_lastprivate);
5649
5650	// Check lastprivate variables in worksharing constructs
5651	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
5652	std::make_pair(
5653	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
5654	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
5655	std::make_pair(
5656	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
5657
5658	CheckPrivateSymbolsInOuterCxt(
5659	currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_lastprivate);
5660
5661	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_lastprivate,
5662	GetContext().clauseSource, context_)) {
5663	auto &modifiers{OmpGetModifiers(x.v)};
5664	using LastprivateModifier = parser::OmpLastprivateModifier;
5665	if (auto *modifier{OmpGetUniqueModifier<LastprivateModifier>(modifiers)}) {
5666	CheckLastprivateModifier(*modifier);
5667	}
5668	}
5669	}
5670
5671	// Add any restrictions related to Modifiers/Directives with
5672	// Lastprivate clause here:
5673	void OmpStructureChecker::CheckLastprivateModifier(
5674	const parser::OmpLastprivateModifier &modifier) {
5675	using LastprivateModifier = parser::OmpLastprivateModifier;
5676	const DirectiveContext &dirCtx{GetContext()};
5677	if (modifier.v == LastprivateModifier::Value::Conditional &&
5678	dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {
5679	// [5.2:268:17]
5680	// The conditional lastprivate-modifier must not be specified.
5681	context_.Say(GetContext().clauseSource,
5682	"'CONDITIONAL' modifier on lastprivate clause with TASKLOOP "
5683	"directive is not allowed"_err_en_US);
5684	}
5685	}
5686
5687	void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
5688	CheckAllowedClause(llvm::omp::Clause::OMPC_copyin);
5689
5690	SymbolSourceMap currSymbols;
5691	GetSymbolsInObjectList(x.v, currSymbols);
5692	CheckCopyingPolymorphicAllocatable(
5693	currSymbols, llvm::omp::Clause::OMPC_copyin);
5694	}
5695
5696	void OmpStructureChecker::CheckStructureComponent(
5697	const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
5698	auto CheckComponent{[&](const parser::Designator &designator) {
5699	if (auto *dataRef{std::get_if<parser::DataRef>(&designator.u)}) {
5700	if (!IsDataRefTypeParamInquiry(dataRef)) {
5701	if (auto *comp{parser::Unwrap<parser::StructureComponent>(*dataRef)}) {
5702	context_.Say(comp->component.source,
5703	"A variable that is part of another variable cannot appear on the %s clause"_err_en_US,
5704	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
5705	}
5706	}
5707	}
5708	}};
5709
5710	for (const auto &object : objects.v) {
5711	common::visit(
5712	common::visitors{
5713	CheckComponent,
5714	[&](const parser::Name &name) {},
5715	},
5716	object.u);
5717	}
5718	}
5719
5720	void OmpStructureChecker::Enter(const parser::OmpClause::Update &x) {
5721	CheckAllowedClause(llvm::omp::Clause::OMPC_update);
5722	llvm::omp::Directive dir{GetContext().directive};
5723	unsigned version{context_.langOptions().OpenMPVersion};
5724
5725	const parser::OmpDependenceType *depType{nullptr};
5726	const parser::OmpTaskDependenceType *taskType{nullptr};
5727	if (auto &maybeUpdate{x.v}) {
5728	depType = std::get_if<parser::OmpDependenceType>(&maybeUpdate->u);
5729	taskType = std::get_if<parser::OmpTaskDependenceType>(&maybeUpdate->u);
5730	}
5731
5732	if (!depType && !taskType) {
5733	assert(dir == llvm::omp::Directive::OMPD_atomic &&
5734	"Unexpected alternative in update clause");
5735	return;
5736	}
5737
5738	if (depType) {
5739	CheckDependenceType(depType->v);
5740	} else if (taskType) {
5741	CheckTaskDependenceType(taskType->v);
5742	}
5743
5744	// [5.1:288:4-5]
5745	// An update clause on a depobj construct must not have source, sink or depobj
5746	// as dependence-type.
5747	// [5.2:322:3]
5748	// task-dependence-type must not be depobj.
5749	if (dir == llvm::omp::OMPD_depobj) {
5750	if (version >= 51) {
5751	bool invalidDep{false};
5752	if (taskType) {
5753	invalidDep =
5754	taskType->v == parser::OmpTaskDependenceType::Value::Depobj;
5755	} else {
5756	invalidDep = true;
5757	}
5758	if (invalidDep) {
5759	context_.Say(GetContext().clauseSource,
5760	"An UPDATE clause on a DEPOBJ construct must not have SINK, SOURCE or DEPOBJ as dependence type"_err_en_US);
5761	}
5762	}
5763	}
5764	}
5765
5766	void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
5767	CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_ptr);
5768	CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_ptr);
5769	SymbolSourceMap currSymbols;
5770	GetSymbolsInObjectList(x.v, currSymbols);
5771	semantics::UnorderedSymbolSet listVars;
5772	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_use_device_ptr)) {
5773	const auto &useDevicePtrClause{
5774	std::get<parser::OmpClause::UseDevicePtr>(clause->u)};
5775	const auto &useDevicePtrList{useDevicePtrClause.v};
5776	std::list<parser::Name> useDevicePtrNameList;
5777	for (const auto &ompObject : useDevicePtrList.v) {
5778	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
5779	if (name->symbol) {
5780	if (!(IsBuiltinCPtr(*(name->symbol)))) {
5781	context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
5782	"Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
5783	name->ToString());
5784	} else {
5785	useDevicePtrNameList.push_back(*name);
5786	}
5787	}
5788	}
5789	}
5790	CheckMultipleOccurrence(
5791	listVars, useDevicePtrNameList, clause->source, "USE_DEVICE_PTR");
5792	}
5793	}
5794
5795	void OmpStructureChecker::Enter(const parser::OmpClause::UseDeviceAddr &x) {
5796	CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_addr);
5797	CheckAllowedClause(llvm::omp::Clause::OMPC_use_device_addr);
5798	SymbolSourceMap currSymbols;
5799	GetSymbolsInObjectList(x.v, currSymbols);
5800	semantics::UnorderedSymbolSet listVars;
5801	for (auto [_, clause] :
5802	FindClauses(llvm::omp::Clause::OMPC_use_device_addr)) {
5803	const auto &useDeviceAddrClause{
5804	std::get<parser::OmpClause::UseDeviceAddr>(clause->u)};
5805	const auto &useDeviceAddrList{useDeviceAddrClause.v};
5806	std::list<parser::Name> useDeviceAddrNameList;
5807	for (const auto &ompObject : useDeviceAddrList.v) {
5808	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
5809	if (name->symbol) {
5810	useDeviceAddrNameList.push_back(*name);
5811	}
5812	}
5813	}
5814	CheckMultipleOccurrence(
5815	listVars, useDeviceAddrNameList, clause->source, "USE_DEVICE_ADDR");
5816	}
5817	}
5818
5819	void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
5820	CheckAllowedClause(llvm::omp::Clause::OMPC_is_device_ptr);
5821	SymbolSourceMap currSymbols;
5822	GetSymbolsInObjectList(x.v, currSymbols);
5823	semantics::UnorderedSymbolSet listVars;
5824	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_is_device_ptr)) {
5825	const auto &isDevicePtrClause{
5826	std::get<parser::OmpClause::IsDevicePtr>(clause->u)};
5827	const auto &isDevicePtrList{isDevicePtrClause.v};
5828	SymbolSourceMap currSymbols;
5829	GetSymbolsInObjectList(isDevicePtrList, currSymbols);
5830	for (auto &[symbol, source] : currSymbols) {
5831	if (!(IsBuiltinCPtr(*symbol))) {
5832	context_.Say(clause->source,
5833	"Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
5834	source.ToString());
5835	} else if (!(IsDummy(*symbol))) {
5836	context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
5837	"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
5838	"This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
5839	source.ToString());
5840	} else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
5841	context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
5842	"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
5843	"that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
5844	"This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
5845	source.ToString());
5846	}
5847	}
5848	}
5849	}
5850
5851	void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) {
5852	CheckAllowedClause(llvm::omp::Clause::OMPC_has_device_addr);
5853	SymbolSourceMap currSymbols;
5854	GetSymbolsInObjectList(x.v, currSymbols);
5855	semantics::UnorderedSymbolSet listVars;
5856	for (auto [_, clause] :
5857	FindClauses(llvm::omp::Clause::OMPC_has_device_addr)) {
5858	const auto &hasDeviceAddrClause{
5859	std::get<parser::OmpClause::HasDeviceAddr>(clause->u)};
5860	const auto &hasDeviceAddrList{hasDeviceAddrClause.v};
5861	std::list<parser::Name> hasDeviceAddrNameList;
5862	for (const auto &ompObject : hasDeviceAddrList.v) {
5863	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
5864	if (name->symbol) {
5865	hasDeviceAddrNameList.push_back(*name);
5866	}
5867	}
5868	}
5869	}
5870	}
5871
5872	void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) {
5873	CheckAllowedClause(llvm::omp::Clause::OMPC_enter);
5874	const parser::OmpObjectList &objList{x.v};
5875	SymbolSourceMap symbols;
5876	GetSymbolsInObjectList(objList, symbols);
5877	for (const auto &[symbol, source] : symbols) {
5878	if (!IsExtendedListItem(*symbol)) {
5879	context_.SayWithDecl(*symbol, source,
5880	"'%s' must be a variable or a procedure"_err_en_US, symbol->name());
5881	}
5882	}
5883	}
5884
5885	void OmpStructureChecker::Enter(const parser::OmpClause::From &x) {
5886	CheckAllowedClause(llvm::omp::Clause::OMPC_from);
5887	if (!OmpVerifyModifiers(
5888	x.v, llvm::omp::OMPC_from, GetContext().clauseSource, context_)) {
5889	return;
5890	}
5891
5892	auto &modifiers{OmpGetModifiers(x.v)};
5893	unsigned version{context_.langOptions().OpenMPVersion};
5894
5895	if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
5896	CheckIteratorModifier(*iter);
5897	}
5898
5899	const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
5900	SymbolSourceMap symbols;
5901	GetSymbolsInObjectList(objList, symbols);
5902	CheckVariableListItem(symbols);
5903
5904	// Ref: [4.5:109:19]
5905	// If a list item is an array section it must specify contiguous storage.
5906	if (version <= 45) {
5907	for (const parser::OmpObject &object : objList.v) {
5908	CheckIfContiguous(object);
5909	}
5910	}
5911	}
5912
5913	void OmpStructureChecker::Enter(const parser::OmpClause::To &x) {
5914	CheckAllowedClause(llvm::omp::Clause::OMPC_to);
5915	if (!OmpVerifyModifiers(
5916	x.v, llvm::omp::OMPC_to, GetContext().clauseSource, context_)) {
5917	return;
5918	}
5919
5920	auto &modifiers{OmpGetModifiers(x.v)};
5921	unsigned version{context_.langOptions().OpenMPVersion};
5922
5923	// The "to" clause is only allowed on "declare target" (pre-5.1), and
5924	// "target update". In the former case it can take an extended list item,
5925	// in the latter a variable (a locator).
5926
5927	// The "declare target" construct (and the "to" clause on it) are already
5928	// handled (in the declare-target checkers), so just look at "to" in "target
5929	// update".
5930	if (GetContext().directive == llvm::omp::OMPD_declare_target) {
5931	return;
5932	}
5933
5934	assert(GetContext().directive == llvm::omp::OMPD_target_update);
5935	if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
5936	CheckIteratorModifier(*iter);
5937	}
5938
5939	const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
5940	SymbolSourceMap symbols;
5941	GetSymbolsInObjectList(objList, symbols);
5942	CheckVariableListItem(symbols);
5943
5944	// Ref: [4.5:109:19]
5945	// If a list item is an array section it must specify contiguous storage.
5946	if (version <= 45) {
5947	for (const parser::OmpObject &object : objList.v) {
5948	CheckIfContiguous(object);
5949	}
5950	}
5951	}
5952
5953	void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {
5954	// Don't call CheckAllowedClause, because it allows "ompx_bare" on
5955	// a non-combined "target" directive (for reasons of splitting combined
5956	// directives). In source code it's only allowed on "target teams".
5957	if (GetContext().directive != llvm::omp::Directive::OMPD_target_teams) {
5958	context_.Say(GetContext().clauseSource,
5959	"%s clause is only allowed on combined TARGET TEAMS"_err_en_US,
5960	parser::ToUpperCaseLetters(getClauseName(llvm::omp::OMPC_ompx_bare)));
5961	}
5962	}
5963
5964	void OmpStructureChecker::Enter(const parser::OmpClause::When &x) {
5965	CheckAllowedClause(llvm::omp::Clause::OMPC_when);
5966	OmpVerifyModifiers(
5967	x.v, llvm::omp::OMPC_when, GetContext().clauseSource, context_);
5968	}
5969
5970	void OmpStructureChecker::Enter(const parser::OmpContextSelector &ctx) {
5971	EnterDirectiveNest(index: ContextSelectorNest);
5972
5973	using SetName = parser::OmpTraitSetSelectorName;
5974	std::map<SetName::Value, const SetName *> visited;
5975
5976	for (const parser::OmpTraitSetSelector &traitSet : ctx.v) {
5977	auto &name{std::get<SetName>(traitSet.t)};
5978	auto [prev, unique]{visited.insert(std::make_pair(name.v, &name))};
5979	if (!unique) {
5980	std::string showName{parser::ToUpperCaseLetters(name.ToString())};
5981	parser::MessageFormattedText txt(
5982	"Repeated trait set name %s in a context specifier"_err_en_US,
5983	showName);
5984	parser::Message message(name.source, txt);
5985	message.Attach(prev->second->source,
5986	"Previous trait set %s provided here"_en_US, showName);
5987	context_.Say(std::move(message));
5988	}
5989	CheckTraitSetSelector(traitSet);
5990	}
5991	}
5992
5993	void OmpStructureChecker::Leave(const parser::OmpContextSelector &) {
5994	ExitDirectiveNest(index: ContextSelectorNest);
5995	}
5996
5997	const std::list<parser::OmpTraitProperty> &
5998	OmpStructureChecker::GetTraitPropertyList(
5999	const parser::OmpTraitSelector &trait) {
6000	static const std::list<parser::OmpTraitProperty> empty{};
6001	auto &[_, maybeProps]{trait.t};
6002	if (maybeProps) {
6003	using PropertyList = std::list<parser::OmpTraitProperty>;
6004	return std::get<PropertyList>(maybeProps->t);
6005	} else {
6006	return empty;
6007	}
6008	}
6009
6010	std::optional<llvm::omp::Clause> OmpStructureChecker::GetClauseFromProperty(
6011	const parser::OmpTraitProperty &property) {
6012	using MaybeClause = std::optional<llvm::omp::Clause>;
6013
6014	// The parser for OmpClause will only succeed if the clause was
6015	// given with all required arguments.
6016	// If this is a string or complex extension with a clause name,
6017	// treat it as a clause and let the trait checker deal with it.
6018
6019	auto getClauseFromString{[&](const std::string &s) -> MaybeClause {
6020	auto id{llvm::omp::getOpenMPClauseKind(parser::ToLowerCaseLetters(s))};
6021	if (id != llvm::omp::Clause::OMPC_unknown) {
6022	return id;
6023	} else {
6024	return std::nullopt;
6025	}
6026	}};
6027
6028	return common::visit( //
6029	common::visitors{
6030	[&](const parser::OmpTraitPropertyName &x) -> MaybeClause {
6031	return getClauseFromString(x.v);
6032	},
6033	[&](const common::Indirection<parser::OmpClause> &x) -> MaybeClause {
6034	return x.value().Id();
6035	},
6036	[&](const parser::ScalarExpr &x) -> MaybeClause {
6037	return std::nullopt;
6038	},
6039	[&](const parser::OmpTraitPropertyExtension &x) -> MaybeClause {
6040	using ExtProperty = parser::OmpTraitPropertyExtension;
6041	if (auto *name{std::get_if<parser::OmpTraitPropertyName>(&x.u)}) {
6042	return getClauseFromString(name->v);
6043	} else if (auto *cpx{std::get_if<ExtProperty::Complex>(&x.u)}) {
6044	return getClauseFromString(
6045	std::get<parser::OmpTraitPropertyName>(cpx->t).v);
6046	}
6047	return std::nullopt;
6048	},
6049	},
6050	property.u);
6051	}
6052
6053	void OmpStructureChecker::CheckTraitSelectorList(
6054	const std::list<parser::OmpTraitSelector> &traits) {
6055	// [6.0:322:20]
6056	// Each trait-selector-name may only be specified once in a trait selector
6057	// set.
6058
6059	// Cannot store OmpTraitSelectorName directly, because it's not copyable.
6060	using TraitName = parser::OmpTraitSelectorName;
6061	using BareName = decltype(TraitName::u);
6062	std::map<BareName, const TraitName *> visited;
6063
6064	for (const parser::OmpTraitSelector &trait : traits) {
6065	auto &name{std::get<TraitName>(trait.t)};
6066
6067	auto [prev, unique]{visited.insert(std::make_pair(name.u, &name))};
6068	if (!unique) {
6069	std::string showName{parser::ToUpperCaseLetters(name.ToString())};
6070	parser::MessageFormattedText txt(
6071	"Repeated trait name %s in a trait set"_err_en_US, showName);
6072	parser::Message message(name.source, txt);
6073	message.Attach(prev->second->source,
6074	"Previous trait %s provided here"_en_US, showName);
6075	context_.Say(std::move(message));
6076	}
6077	}
6078	}
6079
6080	void OmpStructureChecker::CheckTraitSetSelector(
6081	const parser::OmpTraitSetSelector &traitSet) {
6082
6083	// Trait Set | Allowed traits | D-traits | X-traits | Score |
6084	//
6085	// Construct | Simd, directive-name | Yes | No | No |
6086	// Device | Arch, Isa, Kind | No | Yes | No |
6087	// Implementation | Atomic_Default_Mem_Order | No | Yes | Yes |
6088	// | Extension, Requires | | | |
6089	// | Vendor | | | |
6090	// Target_Device | Arch, Device_Num, Isa | No | Yes | No |
6091	// | Kind, Uid | | | |
6092	// User | Condition | No | No | Yes |
6093
6094	struct TraitSetConfig {
6095	std::set<parser::OmpTraitSelectorName::Value> allowed;
6096	bool allowsDirectiveTraits;
6097	bool allowsExtensionTraits;
6098	bool allowsScore;
6099	};
6100
6101	using SName = parser::OmpTraitSetSelectorName::Value;
6102	using TName = parser::OmpTraitSelectorName::Value;
6103
6104	static const std::map<SName, TraitSetConfig> configs{
6105	{SName::Construct, //
6106	{{TName::Simd}, true, false, false}},
6107	{SName::Device, //
6108	{{TName::Arch, TName::Isa, TName::Kind}, false, true, false}},
6109	{SName::Implementation, //
6110	{{TName::Atomic_Default_Mem_Order, TName::Extension, TName::Requires,
6111	TName::Vendor},
6112	false, true, true}},
6113	{SName::Target_Device, //
6114	{{TName::Arch, TName::Device_Num, TName::Isa, TName::Kind,
6115	TName::Uid},
6116	false, true, false}},
6117	{SName::User, //
6118	{{TName::Condition}, false, false, true}},
6119	};
6120
6121	auto checkTraitSet{[&](const TraitSetConfig &config) {
6122	auto &[setName, traits]{traitSet.t};
6123	auto usn{parser::ToUpperCaseLetters(setName.ToString())};
6124
6125	// Check if there are any duplicate traits.
6126	CheckTraitSelectorList(traits);
6127
6128	for (const parser::OmpTraitSelector &trait : traits) {
6129	// Don't use structured bindings here, because they cannot be captured
6130	// before C++20.
6131	auto &traitName = std::get<parser::OmpTraitSelectorName>(trait.t);
6132	auto &maybeProps =
6133	std::get<std::optional<parser::OmpTraitSelector::Properties>>(
6134	trait.t);
6135
6136	// Check allowed traits
6137	common::visit( //
6138	common::visitors{
6139	[&](parser::OmpTraitSelectorName::Value v) {
6140	if (!config.allowed.count(v)) {
6141	context_.Say(traitName.source,
6142	"%s is not a valid trait for %s trait set"_err_en_US,
6143	parser::ToUpperCaseLetters(traitName.ToString()), usn);
6144	}
6145	},
6146	[&](llvm::omp::Directive) {
6147	if (!config.allowsDirectiveTraits) {
6148	context_.Say(traitName.source,
6149	"Directive name is not a valid trait for %s trait set"_err_en_US,
6150	usn);
6151	}
6152	},
6153	[&](const std::string &) {
6154	if (!config.allowsExtensionTraits) {
6155	context_.Say(traitName.source,
6156	"Extension traits are not valid for %s trait set"_err_en_US,
6157	usn);
6158	}
6159	},
6160	},
6161	traitName.u);
6162
6163	// Check score
6164	if (maybeProps) {
6165	auto &[maybeScore, _]{maybeProps->t};
6166	if (maybeScore) {
6167	CheckTraitScore(*maybeScore);
6168	}
6169	}
6170
6171	// Check the properties of the individual traits
6172	CheckTraitSelector(traitSet, trait);
6173	}
6174	}};
6175
6176	checkTraitSet(
6177	configs.at(std::get<parser::OmpTraitSetSelectorName>(traitSet.t).v));
6178	}
6179
6180	void OmpStructureChecker::CheckTraitScore(const parser::OmpTraitScore &score) {
6181	// [6.0:322:23]
6182	// A score-expression must be a non-negative constant integer expression.
6183	if (auto value{GetIntValue(score)}; !value || value < 0) {
6184	context_.Say(score.source,
6185	"SCORE expression must be a non-negative constant integer expression"_err_en_US);
6186	}
6187	}
6188
6189	bool OmpStructureChecker::VerifyTraitPropertyLists(
6190	const parser::OmpTraitSetSelector &traitSet,
6191	const parser::OmpTraitSelector &trait) {
6192	using TraitName = parser::OmpTraitSelectorName;
6193	using PropertyList = std::list<parser::OmpTraitProperty>;
6194	auto &[traitName, maybeProps]{trait.t};
6195
6196	auto checkPropertyList{[&](const PropertyList &properties, auto isValid,
6197	const std::string &message) {
6198	bool foundInvalid{false};
6199	for (const parser::OmpTraitProperty &prop : properties) {
6200	if (!isValid(prop)) {
6201	if (foundInvalid) {
6202	context_.Say(
6203	prop.source, "More invalid properties are present"_err_en_US);
6204	break;
6205	}
6206	context_.Say(prop.source, "%s"_err_en_US, message);
6207	foundInvalid = true;
6208	}
6209	}
6210	return !foundInvalid;
6211	}};
6212
6213	bool invalid{false};
6214
6215	if (std::holds_alternative<llvm::omp::Directive>(traitName.u)) {
6216	// Directive-name traits don't have properties.
6217	if (maybeProps) {
6218	context_.Say(trait.source,
6219	"Directive-name traits cannot have properties"_err_en_US);
6220	invalid = true;
6221	}
6222	}
6223	// Ignore properties on extension traits.
6224
6225	// See `TraitSelectorParser` in openmp-parser.cpp
6226	if (auto *v{std::get_if<TraitName::Value>(&traitName.u)}) {
6227	switch (*v) {
6228	// name-list properties
6229	case parser::OmpTraitSelectorName::Value::Arch:
6230	case parser::OmpTraitSelectorName::Value::Extension:
6231	case parser::OmpTraitSelectorName::Value::Isa:
6232	case parser::OmpTraitSelectorName::Value::Kind:
6233	case parser::OmpTraitSelectorName::Value::Uid:
6234	case parser::OmpTraitSelectorName::Value::Vendor:
6235	if (maybeProps) {
6236	auto isName{[](const parser::OmpTraitProperty &prop) {
6237	return std::holds_alternative<parser::OmpTraitPropertyName>(prop.u);
6238	}};
6239	invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
6240	isName, "Trait property should be a name");
6241	}
6242	break;
6243	// clause-list
6244	case parser::OmpTraitSelectorName::Value::Atomic_Default_Mem_Order:
6245	case parser::OmpTraitSelectorName::Value::Requires:
6246	case parser::OmpTraitSelectorName::Value::Simd:
6247	if (maybeProps) {
6248	auto isClause{[&](const parser::OmpTraitProperty &prop) {
6249	return GetClauseFromProperty(prop).has_value();
6250	}};
6251	invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
6252	isClause, "Trait property should be a clause");
6253	}
6254	break;
6255	// expr-list
6256	case parser::OmpTraitSelectorName::Value::Condition:
6257	case parser::OmpTraitSelectorName::Value::Device_Num:
6258	if (maybeProps) {
6259	auto isExpr{[](const parser::OmpTraitProperty &prop) {
6260	return std::holds_alternative<parser::ScalarExpr>(prop.u);
6261	}};
6262	invalid = !checkPropertyList(std::get<PropertyList>(maybeProps->t),
6263	isExpr, "Trait property should be a scalar expression");
6264	}
6265	break;
6266	} // switch
6267	}
6268
6269	return !invalid;
6270	}
6271
6272	void OmpStructureChecker::CheckTraitSelector(
6273	const parser::OmpTraitSetSelector &traitSet,
6274	const parser::OmpTraitSelector &trait) {
6275	using TraitName = parser::OmpTraitSelectorName;
6276	auto &[traitName, maybeProps]{trait.t};
6277
6278	// Only do the detailed checks if the property lists are valid.
6279	if (VerifyTraitPropertyLists(traitSet, trait)) {
6280	if (std::holds_alternative<llvm::omp::Directive>(traitName.u) ||
6281	std::holds_alternative<std::string>(traitName.u)) {
6282	// No properties here: directives don't have properties, and
6283	// we don't implement any extension traits now.
6284	return;
6285	}
6286
6287	// Specific traits we want to check.
6288	// Limitations:
6289	// (1) The properties for these traits are defined in "Additional
6290	// Definitions for the OpenMP API Specification". It's not clear how
6291	// to define them in a portable way, and how to verify their validity,
6292	// especially if they get replaced by their integer values (in case
6293	// they are defined as enums).
6294	// (2) These are entirely implementation-defined, and at the moment
6295	// there is no known schema to validate these values.
6296	auto v{std::get<TraitName::Value>(traitName.u)};
6297	switch (v) {
6298	case TraitName::Value::Arch:
6299	// Unchecked, TBD(1)
6300	break;
6301	case TraitName::Value::Atomic_Default_Mem_Order:
6302	CheckTraitADMO(traitSet, trait);
6303	break;
6304	case TraitName::Value::Condition:
6305	CheckTraitCondition(traitSet, trait);
6306	break;
6307	case TraitName::Value::Device_Num:
6308	CheckTraitDeviceNum(traitSet, trait);
6309	break;
6310	case TraitName::Value::Extension:
6311	// Ignore
6312	break;
6313	case TraitName::Value::Isa:
6314	// Unchecked, TBD(1)
6315	break;
6316	case TraitName::Value::Kind:
6317	// Unchecked, TBD(1)
6318	break;
6319	case TraitName::Value::Requires:
6320	CheckTraitRequires(traitSet, trait);
6321	break;
6322	case TraitName::Value::Simd:
6323	CheckTraitSimd(traitSet, trait);
6324	break;
6325	case TraitName::Value::Uid:
6326	// Unchecked, TBD(2)
6327	break;
6328	case TraitName::Value::Vendor:
6329	// Unchecked, TBD(1)
6330	break;
6331	}
6332	}
6333	}
6334
6335	void OmpStructureChecker::CheckTraitADMO(
6336	const parser::OmpTraitSetSelector &traitSet,
6337	const parser::OmpTraitSelector &trait) {
6338	auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6339	auto &properties{GetTraitPropertyList(trait)};
6340
6341	if (properties.size() != 1) {
6342	context_.Say(trait.source,
6343	"%s trait requires a single clause property"_err_en_US,
6344	parser::ToUpperCaseLetters(traitName.ToString()));
6345	} else {
6346	const parser::OmpTraitProperty &property{properties.front()};
6347	auto clauseId{*GetClauseFromProperty(property)};
6348	// Check that the clause belongs to the memory-order clause-set.
6349	// Clause sets will hopefully be autogenerated at some point.
6350	switch (clauseId) {
6351	case llvm::omp::Clause::OMPC_acq_rel:
6352	case llvm::omp::Clause::OMPC_acquire:
6353	case llvm::omp::Clause::OMPC_relaxed:
6354	case llvm::omp::Clause::OMPC_release:
6355	case llvm::omp::Clause::OMPC_seq_cst:
6356	break;
6357	default:
6358	context_.Say(property.source,
6359	"%s trait requires a clause from the memory-order clause set"_err_en_US,
6360	parser::ToUpperCaseLetters(traitName.ToString()));
6361	}
6362
6363	using ClauseProperty = common::Indirection<parser::OmpClause>;
6364	if (!std::holds_alternative<ClauseProperty>(property.u)) {
6365	context_.Say(property.source,
6366	"Invalid clause specification for %s"_err_en_US,
6367	parser::ToUpperCaseLetters(getClauseName(clauseId)));
6368	}
6369	}
6370	}
6371
6372	void OmpStructureChecker::CheckTraitCondition(
6373	const parser::OmpTraitSetSelector &traitSet,
6374	const parser::OmpTraitSelector &trait) {
6375	auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6376	auto &properties{GetTraitPropertyList(trait)};
6377
6378	if (properties.size() != 1) {
6379	context_.Say(trait.source,
6380	"%s trait requires a single expression property"_err_en_US,
6381	parser::ToUpperCaseLetters(traitName.ToString()));
6382	} else {
6383	const parser::OmpTraitProperty &property{properties.front()};
6384	auto &scalarExpr{std::get<parser::ScalarExpr>(property.u)};
6385
6386	auto maybeType{GetDynamicType(scalarExpr.thing.value())};
6387	if (!maybeType || maybeType->category() != TypeCategory::Logical) {
6388	context_.Say(property.source,
6389	"%s trait requires a single LOGICAL expression"_err_en_US,
6390	parser::ToUpperCaseLetters(traitName.ToString()));
6391	}
6392	}
6393	}
6394
6395	void OmpStructureChecker::CheckTraitDeviceNum(
6396	const parser::OmpTraitSetSelector &traitSet,
6397	const parser::OmpTraitSelector &trait) {
6398	auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6399	auto &properties{GetTraitPropertyList(trait)};
6400
6401	if (properties.size() != 1) {
6402	context_.Say(trait.source,
6403	"%s trait requires a single expression property"_err_en_US,
6404	parser::ToUpperCaseLetters(traitName.ToString()));
6405	}
6406	// No other checks at the moment.
6407	}
6408
6409	void OmpStructureChecker::CheckTraitRequires(
6410	const parser::OmpTraitSetSelector &traitSet,
6411	const parser::OmpTraitSelector &trait) {
6412	unsigned version{context_.langOptions().OpenMPVersion};
6413	auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6414	auto &properties{GetTraitPropertyList(trait)};
6415
6416	for (const parser::OmpTraitProperty &property : properties) {
6417	auto clauseId{*GetClauseFromProperty(property)};
6418	if (!llvm::omp::isAllowedClauseForDirective(
6419	llvm::omp::OMPD_requires, clauseId, version)) {
6420	context_.Say(property.source,
6421	"%s trait requires a clause from the requirement clause set"_err_en_US,
6422	parser::ToUpperCaseLetters(traitName.ToString()));
6423	}
6424
6425	using ClauseProperty = common::Indirection<parser::OmpClause>;
6426	if (!std::holds_alternative<ClauseProperty>(property.u)) {
6427	context_.Say(property.source,
6428	"Invalid clause specification for %s"_err_en_US,
6429	parser::ToUpperCaseLetters(getClauseName(clauseId)));
6430	}
6431	}
6432	}
6433
6434	void OmpStructureChecker::CheckTraitSimd(
6435	const parser::OmpTraitSetSelector &traitSet,
6436	const parser::OmpTraitSelector &trait) {
6437	unsigned version{context_.langOptions().OpenMPVersion};
6438	auto &traitName{std::get<parser::OmpTraitSelectorName>(trait.t)};
6439	auto &properties{GetTraitPropertyList(trait)};
6440
6441	for (const parser::OmpTraitProperty &property : properties) {
6442	auto clauseId{*GetClauseFromProperty(property)};
6443	if (!llvm::omp::isAllowedClauseForDirective(
6444	llvm::omp::OMPD_declare_simd, clauseId, version)) {
6445	context_.Say(property.source,
6446	"%s trait requires a clause that is allowed on the %s directive"_err_en_US,
6447	parser::ToUpperCaseLetters(traitName.ToString()),
6448	parser::ToUpperCaseLetters(
6449	getDirectiveName(llvm::omp::OMPD_declare_simd)));
6450	}
6451
6452	using ClauseProperty = common::Indirection<parser::OmpClause>;
6453	if (!std::holds_alternative<ClauseProperty>(property.u)) {
6454	context_.Say(property.source,
6455	"Invalid clause specification for %s"_err_en_US,
6456	parser::ToUpperCaseLetters(getClauseName(clauseId)));
6457	}
6458	}
6459	}
6460
6461	llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
6462	return llvm::omp::getOpenMPClauseName(clause);
6463	}
6464
6465	llvm::StringRef OmpStructureChecker::getDirectiveName(
6466	llvm::omp::Directive directive) {
6467	unsigned version{context_.langOptions().OpenMPVersion};
6468	return llvm::omp::getOpenMPDirectiveName(directive, version);
6469	}
6470
6471	const Symbol *OmpStructureChecker::GetObjectSymbol(
6472	const parser::OmpObject &object) {
6473	// Some symbols may be missing if the resolution failed, e.g. when an
6474	// undeclared name is used with implicit none.
6475	if (auto *name{std::get_if<parser::Name>(&object.u)}) {
6476	return name->symbol ? &name->symbol->GetUltimate() : nullptr;
6477	} else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
6478	auto &last{GetLastName(*desg)};
6479	return last.symbol ? &GetLastName(*desg).symbol->GetUltimate() : nullptr;
6480	}
6481	return nullptr;
6482	}
6483
6484	const Symbol *OmpStructureChecker::GetArgumentSymbol(
6485	const parser::OmpArgument &argument) {
6486	if (auto *locator{std::get_if<parser::OmpLocator>(&argument.u)}) {
6487	if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
6488	return GetObjectSymbol(*object);
6489	}
6490	}
6491	return nullptr;
6492	}
6493
6494	std::optional<parser::CharBlock> OmpStructureChecker::GetObjectSource(
6495	const parser::OmpObject &object) {
6496	if (auto *name{std::get_if<parser::Name>(&object.u)}) {
6497	return name->source;
6498	} else if (auto *desg{std::get_if<parser::Designator>(&object.u)}) {
6499	return GetLastName(*desg).source;
6500	}
6501	return std::nullopt;
6502	}
6503
6504	void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
6505	common::visit(
6506	common::visitors{
6507	[&](const common::Indirection<parser::ArrayElement> &elem) {
6508	// Check if the base element is valid on Depend Clause
6509	CheckDependList(elem.value().base);
6510	},
6511	[&](const common::Indirection<parser::StructureComponent> &comp) {
6512	CheckDependList(comp.value().base);
6513	},
6514	[&](const common::Indirection<parser::CoindexedNamedObject> &) {
6515	context_.Say(GetContext().clauseSource,
6516	"Coarrays are not supported in DEPEND clause"_err_en_US);
6517	},
6518	[&](const parser::Name &) {},
6519	},
6520	d.u);
6521	}
6522
6523	// Called from both Reduction and Depend clause.
6524	void OmpStructureChecker::CheckArraySection(
6525	const parser::ArrayElement &arrayElement, const parser::Name &name,
6526	const llvm::omp::Clause clause) {
6527	if (!arrayElement.subscripts.empty()) {
6528	for (const auto &subscript : arrayElement.subscripts) {
6529	if (const auto *triplet{
6530	std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
6531	if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
6532	std::optional<int64_t> strideVal{std::nullopt};
6533	if (const auto &strideExpr = std::get<2>(triplet->t)) {
6534	// OpenMP 6.0 Section 5.2.5: Array Sections
6535	// Restrictions: if a stride expression is specified it must be
6536	// positive. A stride of 0 doesn't make sense.
6537	strideVal = GetIntValue(strideExpr);
6538	if (strideVal && *strideVal < 1) {
6539	context_.Say(GetContext().clauseSource,
6540	"'%s' in %s clause must have a positive stride"_err_en_US,
6541	name.ToString(),
6542	parser::ToUpperCaseLetters(getClauseName(clause).str()));
6543	}
6544	}
6545	const auto &lower{std::get<0>(triplet->t)};
6546	const auto &upper{std::get<1>(triplet->t)};
6547	if (lower && upper) {
6548	const auto lval{GetIntValue(lower)};
6549	const auto uval{GetIntValue(upper)};
6550	if (lval && uval) {
6551	int64_t sectionLen = *uval - *lval;
6552	if (strideVal) {
6553	sectionLen = sectionLen / *strideVal;
6554	}
6555
6556	if (sectionLen < 1) {
6557	context_.Say(GetContext().clauseSource,
6558	"'%s' in %s clause"
6559	" is a zero size array section"_err_en_US,
6560	name.ToString(),
6561	parser::ToUpperCaseLetters(getClauseName(clause).str()));
6562	break;
6563	}
6564	}
6565	}
6566	}
6567	}
6568	}
6569	}
6570	}
6571
6572	void OmpStructureChecker::CheckIntentInPointer(
6573	SymbolSourceMap &symbols, llvm::omp::Clause clauseId) {
6574	for (auto &[symbol, source] : symbols) {
6575	if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
6576	context_.Say(source,
6577	"Pointer '%s' with the INTENT(IN) attribute may not appear in a %s clause"_err_en_US,
6578	symbol->name(),
6579	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
6580	}
6581	}
6582	}
6583
6584	void OmpStructureChecker::CheckProcedurePointer(
6585	SymbolSourceMap &symbols, llvm::omp::Clause clause) {
6586	for (const auto &[symbol, source] : symbols) {
6587	if (IsProcedurePointer(*symbol)) {
6588	context_.Say(source,
6589	"Procedure pointer '%s' may not appear in a %s clause"_err_en_US,
6590	symbol->name(),
6591	parser::ToUpperCaseLetters(getClauseName(clause).str()));
6592	}
6593	}
6594	}
6595
6596	void OmpStructureChecker::CheckCrayPointee(
6597	const parser::OmpObjectList &objectList, llvm::StringRef clause,
6598	bool suggestToUseCrayPointer) {
6599	SymbolSourceMap symbols;
6600	GetSymbolsInObjectList(objectList, symbols);
6601	for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
6602	const auto *symbol{it->first};
6603	const auto source{it->second};
6604	if (symbol->test(Symbol::Flag::CrayPointee)) {
6605	std::string suggestionMsg = "";
6606	if (suggestToUseCrayPointer)
6607	suggestionMsg = ", use Cray Pointer '" +
6608	semantics::GetCrayPointer(*symbol).name().ToString() + "' instead";
6609	context_.Say(source,
6610	"Cray Pointee '%s' may not appear in %s clause%s"_err_en_US,
6611	symbol->name(), clause.str(), suggestionMsg);
6612	}
6613	}
6614	}
6615
6616	void OmpStructureChecker::GetSymbolsInObjectList(
6617	const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
6618	for (const auto &ompObject : objectList.v) {
6619	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
6620	if (const auto *symbol{name->symbol}) {
6621	if (const auto *commonBlockDetails{
6622	symbol->detailsIf<CommonBlockDetails>()}) {
6623	for (const auto &object : commonBlockDetails->objects()) {
6624	symbols.emplace(&object->GetUltimate(), name->source);
6625	}
6626	} else {
6627	symbols.emplace(&symbol->GetUltimate(), name->source);
6628	}
6629	}
6630	}
6631	}
6632	}
6633
6634	void OmpStructureChecker::CheckDefinableObjects(
6635	SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
6636	for (auto &[symbol, source] : symbols) {
6637	if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
6638	DefinabilityFlags{}, *symbol)}) {
6639	context_
6640	.Say(source,
6641	"Variable '%s' on the %s clause is not definable"_err_en_US,
6642	symbol->name(),
6643	parser::ToUpperCaseLetters(getClauseName(clause).str()))
6644	.Attach(std::move(msg->set_severity(parser::Severity::Because)));
6645	}
6646	}
6647	}
6648
6649	void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
6650	SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
6651	const llvm::omp::Clause currClause) {
6652	SymbolSourceMap enclosingSymbols;
6653	auto range{dirClauseTriple.equal_range(GetContext().directive)};
6654	for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
6655	auto enclosingDir{dirIter->second.first};
6656	auto enclosingClauseSet{dirIter->second.second};
6657	if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
6658	for (auto it{enclosingContext->clauseInfo.begin()};
6659	it != enclosingContext->clauseInfo.end(); ++it) {
6660	if (enclosingClauseSet.test(it->first)) {
6661	if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
6662	GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
6663	}
6664	}
6665	}
6666
6667	// Check if the symbols in current context are private in outer context
6668	for (auto &[symbol, source] : currSymbols) {
6669	if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
6670	context_.Say(source,
6671	"%s variable '%s' is PRIVATE in outer context"_err_en_US,
6672	parser::ToUpperCaseLetters(getClauseName(currClause).str()),
6673	symbol->name());
6674	}
6675	}
6676	}
6677	}
6678	}
6679
6680	bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
6681	const parser::Block &block) {
6682	bool nestedTeams{false};
6683
6684	if (!block.empty()) {
6685	auto it{block.begin()};
6686	if (const auto *ompConstruct{
6687	parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
6688	if (const auto *ompBlockConstruct{
6689	std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
6690	const auto &beginBlockDir{
6691	std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
6692	const auto &beginDir{
6693	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
6694	if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
6695	nestedTeams = true;
6696	}
6697	}
6698	}
6699
6700	if (nestedTeams && ++it == block.end()) {
6701	return true;
6702	}
6703	}
6704
6705	return false;
6706	}
6707
6708	void OmpStructureChecker::CheckWorkshareBlockStmts(
6709	const parser::Block &block, parser::CharBlock source) {
6710	OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
6711
6712	for (auto it{block.begin()}; it != block.end(); ++it) {
6713	if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
6714	parser::Unwrap<parser::ForallStmt>(*it) ||
6715	parser::Unwrap<parser::ForallConstruct>(*it) ||
6716	parser::Unwrap<parser::WhereStmt>(*it) ||
6717	parser::Unwrap<parser::WhereConstruct>(*it)) {
6718	parser::Walk(*it, ompWorkshareBlockChecker);
6719	} else if (const auto *ompConstruct{
6720	parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
6721	if (const auto *ompAtomicConstruct{
6722	std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
6723	// Check if assignment statements in the enclosing OpenMP Atomic
6724	// construct are allowed in the Workshare construct
6725	parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
6726	} else if (const auto *ompCriticalConstruct{
6727	std::get_if<parser::OpenMPCriticalConstruct>(
6728	&ompConstruct->u)}) {
6729	// All the restrictions on the Workshare construct apply to the
6730	// statements in the enclosing critical constructs
6731	const auto &criticalBlock{
6732	std::get<parser::Block>(ompCriticalConstruct->t)};
6733	CheckWorkshareBlockStmts(criticalBlock, source);
6734	} else {
6735	// Check if OpenMP constructs enclosed in the Workshare construct are
6736	// 'Parallel' constructs
6737	auto currentDir{llvm::omp::Directive::OMPD_unknown};
6738	if (const auto *ompBlockConstruct{
6739	std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
6740	const auto &beginBlockDir{
6741	std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
6742	const auto &beginDir{
6743	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
6744	currentDir = beginDir.v;
6745	} else if (const auto *ompLoopConstruct{
6746	std::get_if<parser::OpenMPLoopConstruct>(
6747	&ompConstruct->u)}) {
6748	const auto &beginLoopDir{
6749	std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
6750	const auto &beginDir{
6751	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
6752	currentDir = beginDir.v;
6753	} else if (const auto *ompSectionsConstruct{
6754	std::get_if<parser::OpenMPSectionsConstruct>(
6755	&ompConstruct->u)}) {
6756	const auto &beginSectionsDir{
6757	std::get<parser::OmpBeginSectionsDirective>(
6758	ompSectionsConstruct->t)};
6759	const auto &beginDir{
6760	std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
6761	currentDir = beginDir.v;
6762	}
6763
6764	if (!llvm::omp::topParallelSet.test(currentDir)) {
6765	context_.Say(source,
6766	"OpenMP constructs enclosed in WORKSHARE construct may consist "
6767	"of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
6768	}
6769	}
6770	} else {
6771	context_.Say(source,
6772	"The structured block in a WORKSHARE construct may consist of only "
6773	"SCALAR or ARRAY assignments, FORALL or WHERE statements, "
6774	"FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
6775	}
6776	}
6777	}
6778
6779	void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {
6780	if (auto contig{IsContiguous(object)}; contig && !*contig) {
6781	const parser::Name *name{GetObjectName(object)};
6782	assert(name && "Expecting name component");
6783	context_.Say(name->source,
6784	"Reference to '%s' must be a contiguous object"_err_en_US,
6785	name->ToString());
6786	}
6787	}
6788
6789	namespace {
6790	struct NameHelper {
6791	template <typename T>
6792	static const parser::Name *Visit(const common::Indirection<T> &x) {
6793	return Visit(x.value());
6794	}
6795	static const parser::Name *Visit(const parser::Substring &x) {
6796	return Visit(std::get<parser::DataRef>(x.t));
6797	}
6798	static const parser::Name *Visit(const parser::ArrayElement &x) {
6799	return Visit(x.base);
6800	}
6801	static const parser::Name *Visit(const parser::Designator &x) {
6802	return common::visit([](auto &&s) { return Visit(s); }, x.u);
6803	}
6804	static const parser::Name *Visit(const parser::DataRef &x) {
6805	return common::visit([](auto &&s) { return Visit(s); }, x.u);
6806	}
6807	static const parser::Name *Visit(const parser::OmpObject &x) {
6808	return common::visit([](auto &&s) { return Visit(s); }, x.u);
6809	}
6810	template <typename T> static const parser::Name *Visit(T &&) {
6811	return nullptr;
6812	}
6813	static const parser::Name *Visit(const parser::Name &x) { return &x; }
6814	};
6815	} // namespace
6816
6817	const parser::Name *OmpStructureChecker::GetObjectName(
6818	const parser::OmpObject &object) {
6819	return NameHelper::Visit(object);
6820	}
6821
6822	const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
6823	const parser::OmpClause &clause) {
6824
6825	// Clauses with OmpObjectList as its data member
6826	using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
6827	parser::OmpClause::Copyin, parser::OmpClause::Enter,
6828	parser::OmpClause::Firstprivate, parser::OmpClause::Link,
6829	parser::OmpClause::Private, parser::OmpClause::Shared,
6830	parser::OmpClause::UseDevicePtr, parser::OmpClause::UseDeviceAddr>;
6831
6832	// Clauses with OmpObjectList in the tuple
6833	using TupleObjectListClauses = std::tuple<parser::OmpClause::Aligned,
6834	parser::OmpClause::Allocate, parser::OmpClause::From,
6835	parser::OmpClause::Lastprivate, parser::OmpClause::Map,
6836	parser::OmpClause::Reduction, parser::OmpClause::To>;
6837
6838	// TODO:: Generate the tuples using TableGen.
6839	// Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
6840	return common::visit(
6841	common::visitors{
6842	[&](const auto &x) -> const parser::OmpObjectList * {
6843	using Ty = std::decay_t<decltype(x)>;
6844	if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
6845	return &x.v;
6846	} else if constexpr (common::HasMember<Ty,
6847	TupleObjectListClauses>) {
6848	return &(std::get<parser::OmpObjectList>(x.v.t));
6849	} else {
6850	return nullptr;
6851	}
6852	},
6853	},
6854	clause.u);
6855	}
6856
6857	void OmpStructureChecker::Enter(
6858	const parser::OmpClause::AtomicDefaultMemOrder &x) {
6859	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_atomic_default_mem_order);
6860	}
6861
6862	void OmpStructureChecker::Enter(const parser::OmpClause::DynamicAllocators &x) {
6863	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_dynamic_allocators);
6864	}
6865
6866	void OmpStructureChecker::Enter(const parser::OmpClause::ReverseOffload &x) {
6867	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_reverse_offload);
6868	}
6869
6870	void OmpStructureChecker::Enter(const parser::OmpClause::UnifiedAddress &x) {
6871	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_address);
6872	}
6873
6874	void OmpStructureChecker::Enter(
6875	const parser::OmpClause::UnifiedSharedMemory &x) {
6876	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_unified_shared_memory);
6877	}
6878
6879	void OmpStructureChecker::Enter(const parser::OmpClause::SelfMaps &x) {
6880	CheckAllowedRequiresClause(llvm::omp::Clause::OMPC_self_maps);
6881	}
6882
6883	void OmpStructureChecker::Enter(const parser::DoConstruct &x) {
6884	Base::Enter(x);
6885	loopStack_.push_back(&x);
6886	}
6887
6888	void OmpStructureChecker::Leave(const parser::DoConstruct &x) {
6889	assert(!loopStack_.empty() && "Expecting non-empty loop stack");
6890	#ifndef NDEBUG
6891	const LoopConstruct &top = loopStack_.back();
6892	auto *doc{std::get_if<const parser::DoConstruct *>(&top)};
6893	assert(doc != nullptr && *doc == &x && "Mismatched loop constructs");
6894	#endif
6895	loopStack_.pop_back();
6896	Base::Leave(x);
6897	}
6898
6899	void OmpStructureChecker::Enter(const parser::OpenMPInteropConstruct &x) {
6900	bool isDependClauseOccured{false};
6901	int targetCount{0}, targetSyncCount{0};
6902	const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};
6903	std::set<const Symbol *> objectSymbolList;
6904	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_interop);
6905	const auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
6906	for (const auto &clause : clauseList->v) {
6907	common::visit(
6908	common::visitors{
6909	[&](const parser::OmpClause::Init &initClause) {
6910	if (OmpVerifyModifiers(initClause.v, llvm::omp::OMPC_init,
6911	GetContext().directiveSource, context_)) {
6912
6913	auto &modifiers{OmpGetModifiers(initClause.v)};
6914	auto &&interopTypeModifier{
6915	OmpGetRepeatableModifier<parser::OmpInteropType>(
6916	modifiers)};
6917	for (const auto &it : interopTypeModifier) {
6918	if (it->v == parser::OmpInteropType::Value::TargetSync) {
6919	++targetSyncCount;
6920	} else {
6921	++targetCount;
6922	}
6923	}
6924	}
6925	const auto &interopVar{parser::Unwrap<parser::OmpObject>(
6926	std::get<parser::OmpObject>(initClause.v.t))};
6927	const auto *name{parser::Unwrap<parser::Name>(interopVar)};
6928	const auto *objectSymbol{name->symbol};
6929	if (llvm::is_contained(objectSymbolList, objectSymbol)) {
6930	context_.Say(GetContext().directiveSource,
6931	"Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
6932	} else {
6933	objectSymbolList.insert(objectSymbol);
6934	}
6935	},
6936	[&](const parser::OmpClause::Depend &dependClause) {
6937	isDependClauseOccured = true;
6938	},
6939	[&](const parser::OmpClause::Destroy &destroyClause) {
6940	const auto &interopVar{
6941	parser::Unwrap<parser::OmpObject>(destroyClause.v)};
6942	const auto *name{parser::Unwrap<parser::Name>(interopVar)};
6943	const auto *objectSymbol{name->symbol};
6944	if (llvm::is_contained(objectSymbolList, objectSymbol)) {
6945	context_.Say(GetContext().directiveSource,
6946	"Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
6947	} else {
6948	objectSymbolList.insert(objectSymbol);
6949	}
6950	},
6951	[&](const parser::OmpClause::Use &useClause) {
6952	const auto &interopVar{
6953	parser::Unwrap<parser::OmpObject>(useClause.v)};
6954	const auto *name{parser::Unwrap<parser::Name>(interopVar)};
6955	const auto *objectSymbol{name->symbol};
6956	if (llvm::is_contained(objectSymbolList, objectSymbol)) {
6957	context_.Say(GetContext().directiveSource,
6958	"Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
6959	} else {
6960	objectSymbolList.insert(objectSymbol);
6961	}
6962	},
6963	[&](const auto &) {},
6964	},
6965	clause.u);
6966	}
6967	if (targetCount > 1 || targetSyncCount > 1) {
6968	context_.Say(GetContext().directiveSource,
6969	"Each interop-type may be specified at most once."_err_en_US);
6970	}
6971	if (isDependClauseOccured && !targetSyncCount) {
6972	context_.Say(GetContext().directiveSource,
6973	"A DEPEND clause can only appear on the directive if the interop-type includes TARGETSYNC"_err_en_US);
6974	}
6975	}
6976
6977	void OmpStructureChecker::Leave(const parser::OpenMPInteropConstruct &) {
6978	dirContext_.pop_back();
6979	}
6980
6981	void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
6982	CheckAllowedClause(clause);
6983
6984	if (clause != llvm::omp::Clause::OMPC_atomic_default_mem_order) {
6985	// Check that it does not appear after a device construct
6986	if (deviceConstructFound_) {
6987	context_.Say(GetContext().clauseSource,
6988	"REQUIRES directive with '%s' clause found lexically after device "
6989	"construct"_err_en_US,
6990	parser::ToUpperCaseLetters(getClauseName(clause).str()));
6991	}
6992	}
6993	}
6994
6995	} // namespace Fortran::semantics
6996