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
11	#include "check-directive-structure.h"
12	#include "definable.h"
13	#include "openmp-utils.h"
14	#include "resolve-names-utils.h"
15
16	#include "flang/Common/idioms.h"
17	#include "flang/Common/indirection.h"
18	#include "flang/Common/visit.h"
19	#include "flang/Evaluate/tools.h"
20	#include "flang/Evaluate/type.h"
21	#include "flang/Parser/char-block.h"
22	#include "flang/Parser/characters.h"
23	#include "flang/Parser/message.h"
24	#include "flang/Parser/parse-tree-visitor.h"
25	#include "flang/Parser/parse-tree.h"
26	#include "flang/Parser/tools.h"
27	#include "flang/Semantics/expression.h"
28	#include "flang/Semantics/openmp-directive-sets.h"
29	#include "flang/Semantics/openmp-modifiers.h"
30	#include "flang/Semantics/scope.h"
31	#include "flang/Semantics/semantics.h"
32	#include "flang/Semantics/symbol.h"
33	#include "flang/Semantics/tools.h"
34	#include "flang/Semantics/type.h"
35	#include "flang/Support/Fortran-features.h"
36
37	#include "llvm/ADT/ArrayRef.h"
38	#include "llvm/ADT/STLExtras.h"
39	#include "llvm/ADT/StringRef.h"
40	#include "llvm/Frontend/OpenMP/OMP.h"
41
42	#include <algorithm>
43	#include <cassert>
44	#include <cstdint>
45	#include <iterator>
46	#include <list>
47	#include <map>
48	#include <optional>
49	#include <set>
50	#include <string>
51	#include <tuple>
52	#include <type_traits>
53	#include <utility>
54	#include <variant>
55
56	namespace Fortran::semantics {
57
58	using namespace Fortran::semantics::omp;
59
60	// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
61	#define CHECK_SIMPLE_CLAUSE(X, Y) \
62	void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
63	CheckAllowedClause(llvm::omp::Clause::Y); \
64	}
65
66	#define CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(X, Y) \
67	void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
68	CheckAllowedClause(llvm::omp::Clause::Y); \
69	RequiresConstantPositiveParameter(llvm::omp::Clause::Y, c.v); \
70	}
71
72	#define CHECK_REQ_SCALAR_INT_CLAUSE(X, Y) \
73	void OmpStructureChecker::Enter(const parser::OmpClause::X &c) { \
74	CheckAllowedClause(llvm::omp::Clause::Y); \
75	RequiresPositiveParameter(llvm::omp::Clause::Y, c.v); \
76	}
77
78	// Use when clause don't falls under 'struct OmpClause' in 'parse-tree.h'.
79	#define CHECK_SIMPLE_PARSER_CLAUSE(X, Y) \
80	void OmpStructureChecker::Enter(const parser::X &) { \
81	CheckAllowedClause(llvm::omp::Y); \
82	}
83
84	// 'OmpWorkshareBlockChecker' is used to check the validity of the assignment
85	// statements and the expressions enclosed in an OpenMP Workshare construct
86	class OmpWorkshareBlockChecker {
87	public:
88	OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
89	: context_{context}, source_{source} {}
90
91	template <typename T> bool Pre(const T &) { return true; }
92	template <typename T> void Post(const T &) {}
93
94	bool Pre(const parser::AssignmentStmt &assignment) {
95	const auto &var{std::get<parser::Variable>(assignment.t)};
96	const auto &expr{std::get<parser::Expr>(assignment.t)};
97	const auto *lhs{GetExpr(context_, var)};
98	const auto *rhs{GetExpr(context_, expr)};
99	if (lhs && rhs) {
100	Tristate isDefined{semantics::IsDefinedAssignment(
101	lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
102	if (isDefined == Tristate::Yes) {
103	context_.Say(expr.source,
104	"Defined assignment statement is not "
105	"allowed in a WORKSHARE construct"_err_en_US);
106	}
107	}
108	return true;
109	}
110
111	bool Pre(const parser::Expr &expr) {
112	if (const auto *e{GetExpr(context_, expr)}) {
113	for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
114	const Symbol &root{GetAssociationRoot(symbol)};
115	if (IsFunction(root)) {
116	std::string attrs{""};
117	if (!IsElementalProcedure(root)) {
118	attrs = " non-ELEMENTAL";
119	}
120	if (root.attrs().test(Attr::IMPURE)) {
121	if (attrs != "") {
122	attrs = "," + attrs;
123	}
124	attrs = " IMPURE" + attrs;
125	}
126	if (attrs != "") {
127	context_.Say(expr.source,
128	"User defined%s function '%s' is not allowed in a "
129	"WORKSHARE construct"_err_en_US,
130	attrs, root.name());
131	}
132	}
133	}
134	}
135	return false;
136	}
137
138	private:
139	SemanticsContext &context_;
140	parser::CharBlock source_;
141	};
142
143	// `OmpUnitedTaskDesignatorChecker` is used to check if the designator
144	// can appear within the TASK construct
145	class OmpUnitedTaskDesignatorChecker {
146	public:
147	OmpUnitedTaskDesignatorChecker(SemanticsContext &context)
148	: context_{context} {}
149
150	template <typename T> bool Pre(const T &) { return true; }
151	template <typename T> void Post(const T &) {}
152
153	bool Pre(const parser::Name &name) {
154	if (name.symbol->test(Symbol::Flag::OmpThreadprivate)) {
155	// OpenMP 5.2: 5.2 threadprivate directive restriction
156	context_.Say(name.source,
157	"A THREADPRIVATE variable `%s` cannot appear in an UNTIED TASK region"_err_en_US,
158	name.source);
159	}
160	return true;
161	}
162
163	private:
164	SemanticsContext &context_;
165	};
166
167	bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
168	// Do not do clause checks while processing METADIRECTIVE.
169	// Context selectors can contain clauses that are not given as a part
170	// of a construct, but as trait properties. Testing whether they are
171	// valid or not is deferred to the checks of the context selectors.
172	// As it stands now, these clauses would appear as if they were present
173	// on METADIRECTIVE, leading to incorrect diagnostics.
174	if (GetDirectiveNest(index: ContextSelectorNest) > 0) {
175	return true;
176	}
177
178	unsigned version{context_.langOptions().OpenMPVersion};
179	DirectiveContext &dirCtx = GetContext();
180	llvm::omp::Directive dir{dirCtx.directive};
181
182	if (!llvm::omp::isAllowedClauseForDirective(D: dir, C: clause, Version: version)) {
183	unsigned allowedInVersion{[&] {
184	for (unsigned v : llvm::omp::getOpenMPVersions()) {
185	if (v <= version) {
186	continue;
187	}
188	if (llvm::omp::isAllowedClauseForDirective(D: dir, C: clause, Version: v)) {
189	return v;
190	}
191	}
192	return 0u;
193	}()};
194
195	// Only report it if there is a later version that allows it.
196	// If it's not allowed at all, it will be reported by CheckAllowed.
197	if (allowedInVersion != 0) {
198	auto clauseName{parser::ToUpperCaseLetters(getClauseName(clause).str())};
199	auto dirName{parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
200
201	context_.Say(dirCtx.clauseSource,
202	"%s clause is not allowed on directive %s in %s, %s"_err_en_US,
203	clauseName, dirName, ThisVersion(version),
204	TryVersion(allowedInVersion));
205	}
206	}
207	return CheckAllowed(clause);
208	}
209
210	bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
211	// Definition of close nesting:
212	//
213	// `A region nested inside another region with no parallel region nested
214	// between them`
215	//
216	// Examples:
217	// non-parallel construct 1
218	// non-parallel construct 2
219	// parallel construct
220	// construct 3
221	// In the above example, construct 3 is NOT closely nested inside construct 1
222	// or 2
223	//
224	// non-parallel construct 1
225	// non-parallel construct 2
226	// construct 3
227	// In the above example, construct 3 is closely nested inside BOTH construct 1
228	// and 2
229	//
230	// Algorithm:
231	// Starting from the parent context, Check in a bottom-up fashion, each level
232	// of the context stack. If we have a match for one of the (supplied)
233	// violating directives, `close nesting` is satisfied. If no match is there in
234	// the entire stack, `close nesting` is not satisfied. If at any level, a
235	// `parallel` region is found, `close nesting` is not satisfied.
236
237	if (CurrentDirectiveIsNested()) {
238	int index = dirContext_.size() - 2;
239	while (index != -1) {
240	if (set.test(dirContext_[index].directive)) {
241	return true;
242	} else if (llvm::omp::allParallelSet.test(dirContext_[index].directive)) {
243	return false;
244	}
245	index--;
246	}
247	}
248	return false;
249	}
250
251	void OmpStructureChecker::CheckVariableListItem(
252	const SymbolSourceMap &symbols) {
253	for (auto &[symbol, source] : symbols) {
254	if (!IsVariableListItem(*symbol)) {
255	context_.SayWithDecl(
256	*symbol, source, "'%s' must be a variable"_err_en_US, symbol->name());
257	}
258	}
259	}
260
261	void OmpStructureChecker::CheckDirectiveSpelling(
262	parser::CharBlock spelling, llvm::omp::Directive id) {
263	// Directive names that contain spaces can be spelled in the source without
264	// any of the spaces. Because of that getOpenMPKind* is not guaranteed to
265	// work with the source spelling as the argument.
266	//
267	// To verify the source spellings, we have to get the spelling for a given
268	// version, remove spaces and compare it with the source spelling (also
269	// with spaces removed).
270	auto removeSpaces = [](llvm::StringRef s) {
271	std::string n{s.str()};
272	for (size_t idx{n.size()}; idx > 0; --idx) {
273	if (isspace(n[idx - 1])) {
274	n.erase(pos: idx - 1, n: 1);
275	}
276	}
277	return n;
278	};
279
280	std::string lowerNoWS{removeSpaces(
281	parser::ToLowerCaseLetters({spelling.begin(), spelling.size()}))};
282	llvm::StringRef ref(lowerNoWS);
283	if (ref.starts_with(Prefix: "end")) {
284	ref = ref.drop_front(N: 3);
285	}
286
287	unsigned version{context_.langOptions().OpenMPVersion};
288
289	// For every "future" version v, check if the check if the corresponding
290	// spelling of id was introduced later than the current version. If so,
291	// and if that spelling matches the source spelling, issue a warning.
292	for (unsigned v : llvm::omp::getOpenMPVersions()) {
293	if (v <= version) {
294	continue;
295	}
296	llvm::StringRef name{llvm::omp::getOpenMPDirectiveName(D: id, Ver: v)};
297	auto [kind, versions]{llvm::omp::getOpenMPDirectiveKindAndVersions(Str: name)};
298	assert(kind == id && "Directive kind mismatch");
299
300	if (static_cast<int>(version) >= versions.Min) {
301	continue;
302	}
303	if (ref == removeSpaces(name)) {
304	context_.Say(spelling,
305	"Directive spelling '%s' is introduced in a later OpenMP version, %s"_warn_en_US,
306	parser::ToUpperCaseLetters(ref), TryVersion(versions.Min));
307	break;
308	}
309	}
310	}
311
312	void OmpStructureChecker::CheckMultipleOccurrence(
313	semantics::UnorderedSymbolSet &listVars,
314	const std::list<parser::Name> &nameList, const parser::CharBlock &item,
315	const std::string &clauseName) {
316	for (auto const &var : nameList) {
317	if (llvm::is_contained(listVars, *(var.symbol))) {
318	context_.Say(item,
319	"List item '%s' present at multiple %s clauses"_err_en_US,
320	var.ToString(), clauseName);
321	}
322	listVars.insert(*(var.symbol));
323	}
324	}
325
326	void OmpStructureChecker::CheckMultListItems() {
327	semantics::UnorderedSymbolSet listVars;
328
329	// Aligned clause
330	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_aligned)) {
331	const auto &alignedClause{std::get<parser::OmpClause::Aligned>(clause->u)};
332	const auto &alignedList{std::get<0>(alignedClause.v.t)};
333	std::list<parser::Name> alignedNameList;
334	for (const auto &ompObject : alignedList.v) {
335	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
336	if (name->symbol) {
337	if (FindCommonBlockContaining(*(name->symbol))) {
338	context_.Say(clause->source,
339	"'%s' is a common block name and can not appear in an "
340	"ALIGNED clause"_err_en_US,
341	name->ToString());
342	} else if (!(IsBuiltinCPtr(*(name->symbol)) ||
343	IsAllocatableOrObjectPointer(
344	&name->symbol->GetUltimate()))) {
345	context_.Say(clause->source,
346	"'%s' in ALIGNED clause must be of type C_PTR, POINTER or "
347	"ALLOCATABLE"_err_en_US,
348	name->ToString());
349	} else {
350	alignedNameList.push_back(*name);
351	}
352	} else {
353	// The symbol is null, return early
354	return;
355	}
356	}
357	}
358	CheckMultipleOccurrence(
359	listVars, alignedNameList, clause->source, "ALIGNED");
360	}
361
362	// Nontemporal clause
363	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_nontemporal)) {
364	const auto &nontempClause{
365	std::get<parser::OmpClause::Nontemporal>(clause->u)};
366	const auto &nontempNameList{nontempClause.v};
367	CheckMultipleOccurrence(
368	listVars, nontempNameList, clause->source, "NONTEMPORAL");
369	}
370
371	// Linear clause
372	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_linear)) {
373	auto &linearClause{std::get<parser::OmpClause::Linear>(clause->u)};
374	std::list<parser::Name> nameList;
375	SymbolSourceMap symbols;
376	GetSymbolsInObjectList(
377	std::get<parser::OmpObjectList>(linearClause.v.t), symbols);
378	llvm::transform(symbols, std::back_inserter(nameList), [&](auto &&pair) {
379	return parser::Name{pair.second, const_cast<Symbol *>(pair.first)};
380	});
381	CheckMultipleOccurrence(listVars, nameList, clause->source, "LINEAR");
382	}
383	}
384
385	bool OmpStructureChecker::HasInvalidWorksharingNesting(
386	const parser::CharBlock &source, const OmpDirectiveSet &set) {
387	// set contains all the invalid closely nested directives
388	// for the given directive (`source` here)
389	if (IsCloselyNestedRegion(set)) {
390	context_.Say(source,
391	"A worksharing region may not be closely nested inside a "
392	"worksharing, explicit task, taskloop, critical, ordered, atomic, or "
393	"master region"_err_en_US);
394	return true;
395	}
396	return false;
397	}
398
399	void OmpStructureChecker::HasInvalidTeamsNesting(
400	const llvm::omp::Directive &dir, const parser::CharBlock &source) {
401	if (!llvm::omp::nestedTeamsAllowedSet.test(dir)) {
402	context_.Say(source,
403	"Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be "
404	"strictly nested inside `TEAMS` region."_err_en_US);
405	}
406	}
407
408	void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
409	const parser::CharBlock &source, const parser::Name &name) {
410	if (const auto *symbol{name.symbol}) {
411	const auto *commonBlock{FindCommonBlockContaining(*symbol)};
412	const auto &scope{context_.FindScope(symbol->name())};
413	const Scope &containingScope{GetProgramUnitContaining(scope)};
414	if (!isPredefinedAllocator &&
415	(IsSaved(*symbol) || commonBlock ||
416	containingScope.kind() == Scope::Kind::Module)) {
417	context_.Say(source,
418	"If list items within the %s directive have the "
419	"SAVE attribute, are a common block name, or are "
420	"declared in the scope of a module, then only "
421	"predefined memory allocator parameters can be used "
422	"in the allocator clause"_err_en_US,
423	ContextDirectiveAsFortran());
424	}
425	}
426	}
427
428	void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
429	const parser::CharBlock &source,
430	const parser::OmpObjectList &ompObjectList) {
431	for (const auto &ompObject : ompObjectList.v) {
432	common::visit(
433	common::visitors{
434	[&](const parser::Designator &designator) {
435	if (const auto *dataRef{
436	std::get_if<parser::DataRef>(&designator.u)}) {
437	if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
438	CheckPredefinedAllocatorRestriction(source, *name);
439	}
440	}
441	},
442	[&](const parser::Name &name) {
443	CheckPredefinedAllocatorRestriction(source, name);
444	},
445	},
446	ompObject.u);
447	}
448	}
449
450	void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {
451	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_hint);
452	auto &dirCtx{GetContext()};
453
454	if (std::optional<int64_t> maybeVal{GetIntValue(x.v.v)}) {
455	int64_t val{*maybeVal};
456	if (val >= 0) {
457	// Check contradictory values.
458	if ((val & 0xC) == 0xC || // omp_sync_hint_speculative and nonspeculative
459	(val & 0x3) == 0x3) { // omp_sync_hint_contended and uncontended
460	context_.Say(dirCtx.clauseSource,
461	"The synchronization hint is not valid"_err_en_US);
462	}
463	} else {
464	context_.Say(dirCtx.clauseSource,
465	"Synchronization hint must be non-negative"_err_en_US);
466	}
467	} else {
468	context_.Say(dirCtx.clauseSource,
469	"Synchronization hint must be a constant integer value"_err_en_US);
470	}
471	}
472
473	void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
474	// OmpDirectiveSpecification exists on its own only in METADIRECTIVE.
475	// In other cases it's a part of other constructs that handle directive
476	// context stack by themselves.
477	if (GetDirectiveNest(index: MetadirectiveNest)) {
478	PushContextAndClauseSets(
479	std::get<parser::OmpDirectiveName>(x.t).source, x.DirId());
480	}
481	}
482
483	void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {
484	if (GetDirectiveNest(index: MetadirectiveNest)) {
485	dirContext_.pop_back();
486	}
487	}
488
489	template <typename Checker> struct DirectiveSpellingVisitor {
490	using Directive = llvm::omp::Directive;
491
492	DirectiveSpellingVisitor(Checker &&checker) : checker_(std::move(checker)) {}
493
494	template <typename T> bool Pre(const T &) { return true; }
495	template <typename T> void Post(const T &) {}
496
497	template <typename... Ts>
498	static const parser::OmpDirectiveName &GetDirName(
499	const std::tuple<Ts...> &t) {
500	return std::get<parser::OmpDirectiveSpecification>(t).DirName();
501	}
502
503	bool Pre(const parser::OmpSectionsDirective &x) {
504	checker_(x.source, x.v);
505	return false;
506	}
507	bool Pre(const parser::OpenMPDeclarativeAllocate &x) {
508	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate);
509	return false;
510	}
511	bool Pre(const parser::OpenMPDispatchConstruct &x) {
512	checker_(GetDirName(x.t).source, Directive::OMPD_dispatch);
513	return false;
514	}
515	bool Pre(const parser::OmpErrorDirective &x) {
516	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_error);
517	return false;
518	}
519	bool Pre(const parser::OmpNothingDirective &x) {
520	checker_(x.source, Directive::OMPD_nothing);
521	return false;
522	}
523	bool Pre(const parser::OpenMPExecutableAllocate &x) {
524	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate);
525	return false;
526	}
527	bool Pre(const parser::OpenMPAllocatorsConstruct &x) {
528	checker_(GetDirName(x.t).source, Directive::OMPD_allocators);
529	return false;
530	}
531	bool Pre(const parser::OmpAssumeDirective &x) {
532	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_assume);
533	return false;
534	}
535	bool Pre(const parser::OmpEndAssumeDirective &x) {
536	checker_(x.v.source, Directive::OMPD_assume);
537	return false;
538	}
539	bool Pre(const parser::OmpCriticalDirective &x) {
540	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
541	return false;
542	}
543	bool Pre(const parser::OmpEndCriticalDirective &x) {
544	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
545	return false;
546	}
547	bool Pre(const parser::OmpMetadirectiveDirective &x) {
548	checker_(
549	std::get<parser::Verbatim>(x.t).source, Directive::OMPD_metadirective);
550	return false;
551	}
552	bool Pre(const parser::OpenMPDeclarativeAssumes &x) {
553	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_assumes);
554	return false;
555	}
556	bool Pre(const parser::OpenMPDeclareMapperConstruct &x) {
557	checker_(
558	std::get<parser::Verbatim>(x.t).source, Directive::OMPD_declare_mapper);
559	return false;
560	}
561	bool Pre(const parser::OpenMPDeclareReductionConstruct &x) {
562	checker_(std::get<parser::Verbatim>(x.t).source,
563	Directive::OMPD_declare_reduction);
564	return false;
565	}
566	bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
567	checker_(
568	std::get<parser::Verbatim>(x.t).source, Directive::OMPD_declare_simd);
569	return false;
570	}
571	bool Pre(const parser::OpenMPDeclareTargetConstruct &x) {
572	checker_(
573	std::get<parser::Verbatim>(x.t).source, Directive::OMPD_declare_target);
574	return false;
575	}
576	bool Pre(const parser::OmpDeclareVariantDirective &x) {
577	checker_(std::get<parser::Verbatim>(x.t).source,
578	Directive::OMPD_declare_variant);
579	return false;
580	}
581	bool Pre(const parser::OpenMPThreadprivate &x) {
582	checker_(
583	std::get<parser::Verbatim>(x.t).source, Directive::OMPD_threadprivate);
584	return false;
585	}
586	bool Pre(const parser::OpenMPRequiresConstruct &x) {
587	checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_requires);
588	return false;
589	}
590
591	bool Pre(const parser::OmpBlockDirective &x) {
592	checker_(x.source, x.v);
593	return false;
594	}
595
596	bool Pre(const parser::OmpLoopDirective &x) {
597	checker_(x.source, x.v);
598	return false;
599	}
600
601	bool Pre(const parser::OmpDirectiveSpecification &x) {
602	auto &name = std::get<parser::OmpDirectiveName>(x.t);
603	checker_(name.source, name.v);
604	return false;
605	}
606
607	private:
608	Checker checker_;
609	};
610
611	template <typename T>
612	DirectiveSpellingVisitor(T &&) -> DirectiveSpellingVisitor<T>;
613
614	void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
615	DirectiveSpellingVisitor visitor(
616	[this](parser::CharBlock source, llvm::omp::Directive id) {
617	return CheckDirectiveSpelling(source, id);
618	});
619	parser::Walk(x, visitor);
620
621	// Simd Construct with Ordered Construct Nesting check
622	// We cannot use CurrentDirectiveIsNested() here because
623	// PushContextAndClauseSets() has not been called yet, it is
624	// called individually for each construct. Therefore a
625	// dirContext_ size `1` means the current construct is nested
626	if (dirContext_.size() >= 1) {
627	if (GetDirectiveNest(index: SIMDNest) > 0) {
628	CheckSIMDNest(x);
629	}
630	if (GetDirectiveNest(index: TargetNest) > 0) {
631	CheckTargetNest(x);
632	}
633	}
634	}
635
636	void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
637	for (const auto &[sym, source] : deferredNonVariables_) {
638	context_.SayWithDecl(
639	*sym, source, "'%s' must be a variable"_err_en_US, sym->name());
640	}
641	deferredNonVariables_.clear();
642	}
643
644	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
645	DirectiveSpellingVisitor visitor(
646	[this](parser::CharBlock source, llvm::omp::Directive id) {
647	return CheckDirectiveSpelling(source, id);
648	});
649	parser::Walk(x, visitor);
650
651	EnterDirectiveNest(index: DeclarativeNest);
652	}
653
654	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeConstruct &x) {
655	ExitDirectiveNest(index: DeclarativeNest);
656	}
657
658	void OmpStructureChecker::AddEndDirectiveClauses(
659	const parser::OmpClauseList &clauses) {
660	for (const parser::OmpClause &clause : clauses.v) {
661	GetContext().endDirectiveClauses.push_back(clause.Id());
662	}
663	}
664
665	void OmpStructureChecker::CheckIteratorRange(
666	const parser::OmpIteratorSpecifier &x) {
667	// Check:
668	// 1. Whether begin/end are present.
669	// 2. Whether the step value is non-zero.
670	// 3. If the step has a known sign, whether the lower/upper bounds form
671	// a proper interval.
672	const auto &[begin, end, step]{std::get<parser::SubscriptTriplet>(x.t).t};
673	if (!begin || !end) {
674	context_.Say(x.source,
675	"The begin and end expressions in iterator range-specification are "
676	"mandatory"_err_en_US);
677	}
678	// [5.2:67:19] In a range-specification, if the step is not specified its
679	// value is implicitly defined to be 1.
680	if (auto stepv{step ? GetIntValue(*step) : std::optional<int64_t>{1}}) {
681	if (*stepv == 0) {
682	context_.Say(
683	x.source, "The step value in the iterator range is 0"_warn_en_US);
684	} else if (begin && end) {
685	std::optional<int64_t> beginv{GetIntValue(*begin)};
686	std::optional<int64_t> endv{GetIntValue(*end)};
687	if (beginv && endv) {
688	if (*stepv > 0 && *beginv > *endv) {
689	context_.Say(x.source,
690	"The begin value is greater than the end value in iterator "
691	"range-specification with a positive step"_warn_en_US);
692	} else if (*stepv < 0 && *beginv < *endv) {
693	context_.Say(x.source,
694	"The begin value is less than the end value in iterator "
695	"range-specification with a negative step"_warn_en_US);
696	}
697	}
698	}
699	}
700	}
701
702	void OmpStructureChecker::CheckIteratorModifier(const parser::OmpIterator &x) {
703	// Check if all iterator variables have integer type.
704	for (auto &&iterSpec : x.v) {
705	bool isInteger{true};
706	auto &typeDecl{std::get<parser::TypeDeclarationStmt>(iterSpec.t)};
707	auto &typeSpec{std::get<parser::DeclarationTypeSpec>(typeDecl.t)};
708	if (!std::holds_alternative<parser::IntrinsicTypeSpec>(typeSpec.u)) {
709	isInteger = false;
710	} else {
711	auto &intrinType{std::get<parser::IntrinsicTypeSpec>(typeSpec.u)};
712	if (!std::holds_alternative<parser::IntegerTypeSpec>(intrinType.u)) {
713	isInteger = false;
714	}
715	}
716	if (!isInteger) {
717	context_.Say(iterSpec.source,
718	"The iterator variable must be of integer type"_err_en_US);
719	}
720	CheckIteratorRange(iterSpec);
721	}
722	}
723
724	void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
725	// 2.12.5 Target Construct Restriction
726	bool eligibleTarget{true};
727	llvm::omp::Directive ineligibleTargetDir;
728	common::visit(
729	common::visitors{
730	[&](const parser::OpenMPBlockConstruct &c) {
731	const auto &beginBlockDir{
732	std::get<parser::OmpBeginBlockDirective>(c.t)};
733	const auto &beginDir{
734	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
735	if (beginDir.v == llvm::omp::Directive::OMPD_target_data) {
736	eligibleTarget = false;
737	ineligibleTargetDir = beginDir.v;
738	}
739	},
740	[&](const parser::OpenMPStandaloneConstruct &c) {
741	common::visit(
742	common::visitors{
743	[&](const parser::OpenMPSimpleStandaloneConstruct &c) {
744	switch (llvm::omp::Directive dirId{c.v.DirId()}) {
745	case llvm::omp::Directive::OMPD_target_update:
746	case llvm::omp::Directive::OMPD_target_enter_data:
747	case llvm::omp::Directive::OMPD_target_exit_data:
748	eligibleTarget = false;
749	ineligibleTargetDir = dirId;
750	break;
751	default:
752	break;
753	}
754	},
755	[&](const auto &c) {},
756	},
757	c.u);
758	},
759	[&](const parser::OpenMPLoopConstruct &c) {
760	const auto &beginLoopDir{
761	std::get<parser::OmpBeginLoopDirective>(c.t)};
762	const auto &beginDir{
763	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
764	if (llvm::omp::allTargetSet.test(beginDir.v)) {
765	eligibleTarget = false;
766	ineligibleTargetDir = beginDir.v;
767	}
768	},
769	[&](const auto &c) {},
770	},
771	c.u);
772	if (!eligibleTarget) {
773	context_.Warn(common::UsageWarning::OpenMPUsage,
774	parser::FindSourceLocation(c),
775	"If %s directive is nested inside TARGET region, the behaviour is unspecified"_port_en_US,
776	parser::ToUpperCaseLetters(
777	getDirectiveName(ineligibleTargetDir).str()));
778	}
779	}
780
781	void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
782	const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
783	const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
784	const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
785	const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
786	const parser::Block &block{std::get<parser::Block>(x.t)};
787
788	CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
789
790	PushContextAndClauseSets(beginDir.source, beginDir.v);
791	if (llvm::omp::allTargetSet.test(GetContext().directive)) {
792	EnterDirectiveNest(index: TargetNest);
793	}
794
795	if (CurrentDirectiveIsNested()) {
796	if (llvm::omp::bottomTeamsSet.test(GetContextParent().directive)) {
797	HasInvalidTeamsNesting(beginDir.v, beginDir.source);
798	}
799	if (GetContext().directive == llvm::omp::Directive::OMPD_master) {
800	CheckMasterNesting(x);
801	}
802	// A teams region can only be strictly nested within the implicit parallel
803	// region or a target region.
804	if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
805	GetContextParent().directive != llvm::omp::Directive::OMPD_target) {
806	context_.Say(parser::FindSourceLocation(x),
807	"%s region can only be strictly nested within the implicit parallel "
808	"region or TARGET region"_err_en_US,
809	ContextDirectiveAsFortran());
810	}
811	// If a teams construct is nested within a target construct, that target
812	// construct must contain no statements, declarations or directives outside
813	// of the teams construct.
814	if (GetContext().directive == llvm::omp::Directive::OMPD_teams &&
815	GetContextParent().directive == llvm::omp::Directive::OMPD_target &&
816	!GetDirectiveNest(index: TargetBlockOnlyTeams)) {
817	context_.Say(GetContextParent().directiveSource,
818	"TARGET construct with nested TEAMS region contains statements or "
819	"directives outside of the TEAMS construct"_err_en_US);
820	}
821	}
822
823	CheckNoBranching(block, beginDir.v, beginDir.source);
824
825	// Target block constructs are target device constructs. Keep track of
826	// whether any such construct has been visited to later check that REQUIRES
827	// directives for target-related options don't appear after them.
828	if (llvm::omp::allTargetSet.test(beginDir.v)) {
829	deviceConstructFound_ = true;
830	}
831
832	if (GetContext().directive == llvm::omp::Directive::OMPD_single) {
833	std::set<Symbol *> singleCopyprivateSyms;
834	std::set<Symbol *> endSingleCopyprivateSyms;
835	bool foundNowait{false};
836	parser::CharBlock NowaitSource;
837
838	auto catchCopyPrivateNowaitClauses = [&](const auto &dir, bool endDir) {
839	for (auto &clause : std::get<parser::OmpClauseList>(dir.t).v) {
840	if (clause.Id() == llvm::omp::Clause::OMPC_copyprivate) {
841	for (const auto &ompObject : GetOmpObjectList(clause)->v) {
842	const auto *name{parser::Unwrap<parser::Name>(ompObject)};
843	if (Symbol * symbol{name->symbol}) {
844	if (singleCopyprivateSyms.count(symbol)) {
845	if (endDir) {
846	context_.Warn(common::UsageWarning::OpenMPUsage, name->source,
847	"The COPYPRIVATE clause with '%s' is already used on the SINGLE directive"_warn_en_US,
848	name->ToString());
849	} else {
850	context_.Say(name->source,
851	"'%s' appears in more than one COPYPRIVATE clause on the SINGLE directive"_err_en_US,
852	name->ToString());
853	}
854	} else if (endSingleCopyprivateSyms.count(symbol)) {
855	context_.Say(name->source,
856	"'%s' appears in more than one COPYPRIVATE clause on the END SINGLE directive"_err_en_US,
857	name->ToString());
858	} else {
859	if (endDir) {
860	endSingleCopyprivateSyms.insert(symbol);
861	} else {
862	singleCopyprivateSyms.insert(symbol);
863	}
864	}
865	}
866	}
867	} else if (clause.Id() == llvm::omp::Clause::OMPC_nowait) {
868	if (foundNowait) {
869	context_.Say(clause.source,
870	"At most one NOWAIT clause can appear on the SINGLE directive"_err_en_US);
871	} else {
872	foundNowait = !endDir;
873	}
874	if (!NowaitSource.ToString().size()) {
875	NowaitSource = clause.source;
876	}
877	}
878	}
879	};
880	catchCopyPrivateNowaitClauses(beginBlockDir, false);
881	catchCopyPrivateNowaitClauses(endBlockDir, true);
882	unsigned version{context_.langOptions().OpenMPVersion};
883	if (version <= 52 && NowaitSource.ToString().size() &&
884	(singleCopyprivateSyms.size() || endSingleCopyprivateSyms.size())) {
885	context_.Say(NowaitSource,
886	"NOWAIT clause must not be used with COPYPRIVATE clause on the SINGLE directive"_err_en_US);
887	}
888	}
889
890	switch (beginDir.v) {
891	case llvm::omp::Directive::OMPD_target:
892	if (CheckTargetBlockOnlyTeams(block)) {
893	EnterDirectiveNest(index: TargetBlockOnlyTeams);
894	}
895	break;
896	case llvm::omp::OMPD_workshare:
897	case llvm::omp::OMPD_parallel_workshare:
898	CheckWorkshareBlockStmts(block, beginDir.source);
899	HasInvalidWorksharingNesting(
900	beginDir.source, llvm::omp::nestedWorkshareErrSet);
901	break;
902	case llvm::omp::Directive::OMPD_scope:
903	case llvm::omp::Directive::OMPD_single:
904	// TODO: This check needs to be extended while implementing nesting of
905	// regions checks.
906	HasInvalidWorksharingNesting(
907	beginDir.source, llvm::omp::nestedWorkshareErrSet);
908	break;
909	case llvm::omp::Directive::OMPD_task: {
910	const auto &clauses{std::get<parser::OmpClauseList>(beginBlockDir.t)};
911	for (const auto &clause : clauses.v) {
912	if (std::get_if<parser::OmpClause::Untied>(&clause.u)) {
913	OmpUnitedTaskDesignatorChecker check{context_};
914	parser::Walk(block, check);
915	}
916	}
917	break;
918	}
919	default:
920	break;
921	}
922	}
923
924	void OmpStructureChecker::CheckMasterNesting(
925	const parser::OpenMPBlockConstruct &x) {
926	// A MASTER region may not be `closely nested` inside a worksharing, loop,
927	// task, taskloop, or atomic region.
928	// TODO: Expand the check to include `LOOP` construct as well when it is
929	// supported.
930	if (IsCloselyNestedRegion(llvm::omp::nestedMasterErrSet)) {
931	context_.Say(parser::FindSourceLocation(x),
932	"`MASTER` region may not be closely nested inside of `WORKSHARING`, "
933	"`LOOP`, `TASK`, `TASKLOOP`,"
934	" or `ATOMIC` region."_err_en_US);
935	}
936	}
937
938	void OmpStructureChecker::Enter(const parser::OpenMPAssumeConstruct &x) {
939	PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assume);
940	}
941
942	void OmpStructureChecker::Leave(const parser::OpenMPAssumeConstruct &) {
943	dirContext_.pop_back();
944	}
945
946	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAssumes &x) {
947	PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_assumes);
948	}
949
950	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAssumes &) {
951	dirContext_.pop_back();
952	}
953
954	void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
955	if (GetDirectiveNest(index: TargetBlockOnlyTeams)) {
956	ExitDirectiveNest(index: TargetBlockOnlyTeams);
957	}
958	if (llvm::omp::allTargetSet.test(GetContext().directive)) {
959	ExitDirectiveNest(index: TargetNest);
960	}
961	dirContext_.pop_back();
962	}
963
964	void OmpStructureChecker::ChecksOnOrderedAsBlock() {
965	if (FindClause(llvm::omp::Clause::OMPC_depend)) {
966	context_.Say(GetContext().clauseSource,
967	"DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region"_err_en_US);
968	return;
969	}
970
971	bool isNestedInDo{false};
972	bool isNestedInDoSIMD{false};
973	bool isNestedInSIMD{false};
974	bool noOrderedClause{false};
975	bool isOrderedClauseWithPara{false};
976	bool isCloselyNestedRegion{true};
977	if (CurrentDirectiveIsNested()) {
978	for (int i = (int)dirContext_.size() - 2; i >= 0; i--) {
979	if (llvm::omp::nestedOrderedErrSet.test(dirContext_[i].directive)) {
980	context_.Say(GetContext().directiveSource,
981	"`ORDERED` region may not be closely nested inside of `CRITICAL`, "
982	"`ORDERED`, explicit `TASK` or `TASKLOOP` region."_err_en_US);
983	break;
984	} else if (llvm::omp::allDoSet.test(dirContext_[i].directive)) {
985	isNestedInDo = true;
986	isNestedInDoSIMD =
987	llvm::omp::allDoSimdSet.test(dirContext_[i].directive);
988	if (const auto *clause{
989	FindClause(dirContext_[i], llvm::omp::Clause::OMPC_ordered)}) {
990	const auto &orderedClause{
991	std::get<parser::OmpClause::Ordered>(clause->u)};
992	const auto orderedValue{GetIntValue(orderedClause.v)};
993	isOrderedClauseWithPara = orderedValue > 0;
994	} else {
995	noOrderedClause = true;
996	}
997	break;
998	} else if (llvm::omp::allSimdSet.test(dirContext_[i].directive)) {
999	isNestedInSIMD = true;
1000	break;
1001	} else if (llvm::omp::nestedOrderedParallelErrSet.test(
1002	dirContext_[i].directive)) {
1003	isCloselyNestedRegion = false;
1004	break;
1005	}
1006	}
1007	}
1008
1009	if (!isCloselyNestedRegion) {
1010	context_.Say(GetContext().directiveSource,
1011	"An ORDERED directive without the DEPEND clause must be closely nested "
1012	"in a SIMD, worksharing-loop, or worksharing-loop SIMD "
1013	"region"_err_en_US);
1014	} else {
1015	if (CurrentDirectiveIsNested() &&
1016	FindClause(llvm::omp::Clause::OMPC_simd) &&
1017	(!isNestedInDoSIMD && !isNestedInSIMD)) {
1018	context_.Say(GetContext().directiveSource,
1019	"An ORDERED directive with SIMD clause must be closely nested in a "
1020	"SIMD or worksharing-loop SIMD region"_err_en_US);
1021	}
1022	if (isNestedInDo && (noOrderedClause || isOrderedClauseWithPara)) {
1023	context_.Say(GetContext().directiveSource,
1024	"An ORDERED directive without the DEPEND clause must be closely "
1025	"nested in a worksharing-loop (or worksharing-loop SIMD) region with "
1026	"ORDERED clause without the parameter"_err_en_US);
1027	}
1028	}
1029	}
1030
1031	void OmpStructureChecker::Leave(const parser::OmpBeginBlockDirective &) {
1032	switch (GetContext().directive) {
1033	case llvm::omp::Directive::OMPD_ordered:
1034	// [5.1] 2.19.9 Ordered Construct Restriction
1035	ChecksOnOrderedAsBlock();
1036	break;
1037	default:
1038	break;
1039	}
1040	}
1041
1042	void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {
1043	const auto &beginSectionsDir{
1044	std::get<parser::OmpBeginSectionsDirective>(x.t)};
1045	const auto &endSectionsDir{std::get<parser::OmpEndSectionsDirective>(x.t)};
1046	const auto &beginDir{
1047	std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
1048	const auto &endDir{std::get<parser::OmpSectionsDirective>(endSectionsDir.t)};
1049	CheckMatching<parser::OmpSectionsDirective>(beginDir, endDir);
1050
1051	PushContextAndClauseSets(beginDir.source, beginDir.v);
1052	AddEndDirectiveClauses(std::get<parser::OmpClauseList>(endSectionsDir.t));
1053
1054	const auto &sectionBlocks{std::get<parser::OmpSectionBlocks>(x.t)};
1055	for (const parser::OpenMPConstruct &block : sectionBlocks.v) {
1056	CheckNoBranching(std::get<parser::OpenMPSectionConstruct>(block.u).v,
1057	beginDir.v, beginDir.source);
1058	}
1059	HasInvalidWorksharingNesting(
1060	beginDir.source, llvm::omp::nestedWorkshareErrSet);
1061	}
1062
1063	void OmpStructureChecker::Leave(const parser::OpenMPSectionsConstruct &) {
1064	dirContext_.pop_back();
1065	}
1066
1067	void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {
1068	const auto &dir{std::get<parser::OmpSectionsDirective>(x.t)};
1069	ResetPartialContext(dir.source);
1070	switch (dir.v) {
1071	// 2.7.2 end-sections -> END SECTIONS [nowait-clause]
1072	case llvm::omp::Directive::OMPD_sections:
1073	PushContextAndClauseSets(
1074	dir.source, llvm::omp::Directive::OMPD_end_sections);
1075	break;
1076	default:
1077	// no clauses are allowed
1078	break;
1079	}
1080	}
1081
1082	// TODO: Verify the popping of dirContext requirement after nowait
1083	// implementation, as there is an implicit barrier at the end of the worksharing
1084	// constructs unless a nowait clause is specified. Only OMPD_end_sections is
1085	// popped becuase it is pushed while entering the EndSectionsDirective.
1086	void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
1087	if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
1088	dirContext_.pop_back();
1089	}
1090	}
1091
1092	void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
1093	const parser::OmpObjectList &objList) {
1094	for (const auto &ompObject : objList.v) {
1095	common::visit(
1096	common::visitors{
1097	[&](const parser::Designator &) {
1098	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1099	// The symbol is null, return early, CheckSymbolNames
1100	// should have already reported the missing symbol as a
1101	// diagnostic error
1102	if (!name->symbol) {
1103	return;
1104	}
1105
1106	if (name->symbol->GetUltimate().IsSubprogram()) {
1107	if (GetContext().directive ==
1108	llvm::omp::Directive::OMPD_threadprivate)
1109	context_.Say(name->source,
1110	"The procedure name cannot be in a %s "
1111	"directive"_err_en_US,
1112	ContextDirectiveAsFortran());
1113	// TODO: Check for procedure name in declare target directive.
1114	} else if (name->symbol->attrs().test(Attr::PARAMETER)) {
1115	if (GetContext().directive ==
1116	llvm::omp::Directive::OMPD_threadprivate)
1117	context_.Say(name->source,
1118	"The entity with PARAMETER attribute cannot be in a %s "
1119	"directive"_err_en_US,
1120	ContextDirectiveAsFortran());
1121	else if (GetContext().directive ==
1122	llvm::omp::Directive::OMPD_declare_target)
1123	context_.Warn(common::UsageWarning::OpenMPUsage,
1124	name->source,
1125	"The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,
1126	ContextDirectiveAsFortran());
1127	} else if (FindCommonBlockContaining(*name->symbol)) {
1128	context_.Say(name->source,
1129	"A variable in a %s directive cannot be an element of a "
1130	"common block"_err_en_US,
1131	ContextDirectiveAsFortran());
1132	} else if (FindEquivalenceSet(*name->symbol)) {
1133	context_.Say(name->source,
1134	"A variable in a %s directive cannot appear in an "
1135	"EQUIVALENCE statement"_err_en_US,
1136	ContextDirectiveAsFortran());
1137	} else if (name->symbol->test(Symbol::Flag::OmpThreadprivate) &&
1138	GetContext().directive ==
1139	llvm::omp::Directive::OMPD_declare_target) {
1140	context_.Say(name->source,
1141	"A THREADPRIVATE variable cannot appear in a %s "
1142	"directive"_err_en_US,
1143	ContextDirectiveAsFortran());
1144	} else {
1145	const semantics::Scope &useScope{
1146	context_.FindScope(GetContext().directiveSource)};
1147	const semantics::Scope &curScope =
1148	name->symbol->GetUltimate().owner();
1149	if (!curScope.IsTopLevel()) {
1150	const semantics::Scope &declScope =
1151	GetProgramUnitOrBlockConstructContaining(curScope);
1152	const semantics::Symbol *sym{
1153	declScope.parent().FindSymbol(name->symbol->name())};
1154	if (sym &&
1155	(sym->has<MainProgramDetails>() ||
1156	sym->has<ModuleDetails>())) {
1157	context_.Say(name->source,
1158	"The module name or main program name cannot be in a "
1159	"%s "
1160	"directive"_err_en_US,
1161	ContextDirectiveAsFortran());
1162	} else if (!IsSaved(*name->symbol) &&
1163	declScope.kind() != Scope::Kind::MainProgram &&
1164	declScope.kind() != Scope::Kind::Module) {
1165	context_.Say(name->source,
1166	"A variable that appears in a %s directive must be "
1167	"declared in the scope of a module or have the SAVE "
1168	"attribute, either explicitly or "
1169	"implicitly"_err_en_US,
1170	ContextDirectiveAsFortran());
1171	} else if (useScope != declScope) {
1172	context_.Say(name->source,
1173	"The %s directive and the common block or variable "
1174	"in it must appear in the same declaration section "
1175	"of a scoping unit"_err_en_US,
1176	ContextDirectiveAsFortran());
1177	}
1178	}
1179	}
1180	}
1181	},
1182	[&](const parser::Name &name) {
1183	if (name.symbol) {
1184	if (auto *cb{name.symbol->detailsIf<CommonBlockDetails>()}) {
1185	for (const auto &obj : cb->objects()) {
1186	if (FindEquivalenceSet(*obj)) {
1187	context_.Say(name.source,
1188	"A variable in a %s directive cannot appear in an EQUIVALENCE statement (variable '%s' from common block '/%s/')"_err_en_US,
1189	ContextDirectiveAsFortran(), obj->name(),
1190	name.symbol->name());
1191	}
1192	}
1193	}
1194	}
1195	},
1196	},
1197	ompObject.u);
1198	}
1199	}
1200
1201	void OmpStructureChecker::Enter(const parser::OpenMPThreadprivate &c) {
1202	const auto &dir{std::get<parser::Verbatim>(c.t)};
1203	PushContextAndClauseSets(
1204	dir.source, llvm::omp::Directive::OMPD_threadprivate);
1205	}
1206
1207	void OmpStructureChecker::Leave(const parser::OpenMPThreadprivate &c) {
1208	const auto &dir{std::get<parser::Verbatim>(c.t)};
1209	const auto &objectList{std::get<parser::OmpObjectList>(c.t)};
1210	CheckSymbolNames(dir.source, objectList);
1211	CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
1212	CheckThreadprivateOrDeclareTargetVar(objectList);
1213	dirContext_.pop_back();
1214	}
1215
1216	void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
1217	const auto &dir{std::get<parser::Verbatim>(x.t)};
1218	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
1219	}
1220
1221	void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
1222	dirContext_.pop_back();
1223	}
1224
1225	void OmpStructureChecker::Enter(const parser::OmpDeclareVariantDirective &x) {
1226	const auto &dir{std::get<parser::Verbatim>(x.t)};
1227	PushContextAndClauseSets(
1228	dir.source, llvm::omp::Directive::OMPD_declare_variant);
1229	}
1230
1231	void OmpStructureChecker::Leave(const parser::OmpDeclareVariantDirective &) {
1232	dirContext_.pop_back();
1233	}
1234
1235	void OmpStructureChecker::Enter(const parser::OpenMPDepobjConstruct &x) {
1236	const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
1237	PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_depobj);
1238	unsigned version{context_.langOptions().OpenMPVersion};
1239
1240	const parser::OmpArgumentList &arguments{x.v.Arguments()};
1241	const parser::OmpClauseList &clauses{x.v.Clauses()};
1242
1243	// Ref: [6.0:505-506]
1244
1245	if (version < 60) {
1246	if (arguments.v.size() != 1) {
1247	parser::CharBlock source(
1248	arguments.v.empty() ? dirName.source : arguments.source);
1249	context_.Say(
1250	source, "The DEPOBJ directive requires a single argument"_err_en_US);
1251	}
1252	}
1253	if (clauses.v.size() != 1) {
1254	context_.Say(
1255	x.source, "The DEPOBJ construct requires a single clause"_err_en_US);
1256	return;
1257	}
1258
1259	auto &clause{clauses.v.front()};
1260
1261	if (version >= 60 && arguments.v.empty()) {
1262	context_.Say(x.source,
1263	"DEPOBJ syntax with no argument is not handled yet"_err_en_US);
1264	return;
1265	}
1266
1267	// [5.2:73:27-28]
1268	// If the destroy clause appears on a depobj construct, destroy-var must
1269	// refer to the same depend object as the depobj argument of the construct.
1270	if (clause.Id() == llvm::omp::Clause::OMPC_destroy) {
1271	auto getObjSymbol{[&](const parser::OmpObject &obj) {
1272	return common::visit(
1273	[&](auto &&s) { return GetLastName(s).symbol; }, obj.u);
1274	}};
1275	auto getArgSymbol{[&](const parser::OmpArgument &arg) {
1276	if (auto *locator{std::get_if<parser::OmpLocator>(&arg.u)}) {
1277	if (auto *object{std::get_if<parser::OmpObject>(&locator->u)}) {
1278	return getObjSymbol(*object);
1279	}
1280	}
1281	return static_cast<Symbol *>(nullptr);
1282	}};
1283
1284	auto &wrapper{std::get<parser::OmpClause::Destroy>(clause.u)};
1285	if (const std::optional<parser::OmpDestroyClause> &destroy{wrapper.v}) {
1286	const Symbol *constrSym{getArgSymbol(arguments.v.front())};
1287	const Symbol *clauseSym{getObjSymbol(destroy->v)};
1288	assert(constrSym && "Unresolved depobj construct symbol");
1289	assert(clauseSym && "Unresolved destroy symbol on depobj construct");
1290	if (constrSym != clauseSym) {
1291	context_.Say(x.source,
1292	"The DESTROY clause must refer to the same object as the "
1293	"DEPOBJ construct"_err_en_US);
1294	}
1295	}
1296	}
1297	}
1298
1299	void OmpStructureChecker::Leave(const parser::OpenMPDepobjConstruct &x) {
1300	dirContext_.pop_back();
1301	}
1302
1303	void OmpStructureChecker::Enter(const parser::OpenMPRequiresConstruct &x) {
1304	const auto &dir{std::get<parser::Verbatim>(x.t)};
1305	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_requires);
1306
1307	if (visitedAtomicSource_.empty()) {
1308	return;
1309	}
1310	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1311	for (const parser::OmpClause &clause : clauseList.v) {
1312	llvm::omp::Clause id{clause.Id()};
1313	if (id == llvm::omp::Clause::OMPC_atomic_default_mem_order) {
1314	parser::MessageFormattedText txt(
1315	"REQUIRES directive with '%s' clause found lexically after atomic operation without a memory order clause"_err_en_US,
1316	parser::ToUpperCaseLetters(llvm::omp::getOpenMPClauseName(id)));
1317	parser::Message message(clause.source, txt);
1318	message.Attach(visitedAtomicSource_, "Previous atomic construct"_en_US);
1319	context_.Say(std::move(message));
1320	}
1321	}
1322	}
1323
1324	void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
1325	dirContext_.pop_back();
1326	}
1327
1328	void OmpStructureChecker::CheckAlignValue(const parser::OmpClause &clause) {
1329	if (auto *align{std::get_if<parser::OmpClause::Align>(&clause.u)}) {
1330	if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
1331	context_.Say(clause.source,
1332	"The alignment value should be a constant positive integer"_err_en_US);
1333	}
1334	}
1335	}
1336
1337	void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
1338	isPredefinedAllocator = true;
1339	const auto &dir{std::get<parser::Verbatim>(x.t)};
1340	const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1341	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1342	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1343	SymbolSourceMap currSymbols;
1344	GetSymbolsInObjectList(objectList, currSymbols);
1345	for (auto &[symbol, source] : currSymbols) {
1346	if (IsPointer(*symbol)) {
1347	context_.Say(source,
1348	"List item '%s' in ALLOCATE directive must not have POINTER "
1349	"attribute"_err_en_US,
1350	source.ToString());
1351	}
1352	if (IsDummy(*symbol)) {
1353	context_.Say(source,
1354	"List item '%s' in ALLOCATE directive must not be a dummy "
1355	"argument"_err_en_US,
1356	source.ToString());
1357	}
1358	if (symbol->GetUltimate().has<AssocEntityDetails>()) {
1359	context_.Say(source,
1360	"List item '%s' in ALLOCATE directive must not be an associate "
1361	"name"_err_en_US,
1362	source.ToString());
1363	}
1364	}
1365	for (const auto &clause : clauseList.v) {
1366	CheckAlignValue(clause);
1367	}
1368	CheckVarIsNotPartOfAnotherVar(dir.source, objectList);
1369	}
1370
1371	void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
1372	const auto &dir{std::get<parser::Verbatim>(x.t)};
1373	const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
1374	CheckPredefinedAllocatorRestriction(dir.source, objectList);
1375	dirContext_.pop_back();
1376	}
1377
1378	void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
1379	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_allocator);
1380	// Note: Predefined allocators are stored in ScalarExpr as numbers
1381	// whereas custom allocators are stored as strings, so if the ScalarExpr
1382	// actually has an int value, then it must be a predefined allocator
1383	isPredefinedAllocator = GetIntValue(x.v).has_value();
1384	RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
1385	}
1386
1387	void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {
1388	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_allocate);
1389	if (OmpVerifyModifiers(
1390	x.v, llvm::omp::OMPC_allocate, GetContext().clauseSource, context_)) {
1391	auto &modifiers{OmpGetModifiers(x.v)};
1392	if (auto *align{
1393	OmpGetUniqueModifier<parser::OmpAlignModifier>(modifiers)}) {
1394	if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
1395	context_.Say(OmpGetModifierSource(modifiers, align),
1396	"The alignment value should be a constant positive integer"_err_en_US);
1397	}
1398	}
1399	// The simple and complex modifiers have the same structure. They only
1400	// differ in their syntax.
1401	if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorComplexModifier>(
1402	modifiers)}) {
1403	isPredefinedAllocator = GetIntValue(alloc->v).has_value();
1404	}
1405	if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorSimpleModifier>(
1406	modifiers)}) {
1407	isPredefinedAllocator = GetIntValue(alloc->v).has_value();
1408	}
1409	}
1410	}
1411
1412	void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithClause &x) {
1413	SetClauseSets(llvm::omp::Directive::OMPD_declare_target);
1414	}
1415
1416	void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
1417	if (x.v.v.size() > 0) {
1418	const parser::OmpClause *enterClause =
1419	FindClause(llvm::omp::Clause::OMPC_enter);
1420	const parser::OmpClause *toClause = FindClause(llvm::omp::Clause::OMPC_to);
1421	const parser::OmpClause *linkClause =
1422	FindClause(llvm::omp::Clause::OMPC_link);
1423	const parser::OmpClause *indirectClause =
1424	FindClause(llvm::omp::Clause::OMPC_indirect);
1425	if (!enterClause && !toClause && !linkClause) {
1426	context_.Say(x.source,
1427	"If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US);
1428	}
1429	if (indirectClause && !enterClause) {
1430	context_.Say(x.source,
1431	"The INDIRECT clause cannot be used without the ENTER clause with the DECLARE TARGET directive."_err_en_US);
1432	}
1433	unsigned version{context_.langOptions().OpenMPVersion};
1434	if (toClause && version >= 52) {
1435	context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source,
1436	"The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);
1437	}
1438	if (indirectClause) {
1439	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_indirect);
1440	}
1441	}
1442	}
1443
1444	void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {
1445	const auto &dir{std::get<parser::Verbatim>(x.t)};
1446	PushContextAndClauseSets(
1447	dir.source, llvm::omp::Directive::OMPD_declare_mapper);
1448	const auto &spec{std::get<parser::OmpMapperSpecifier>(x.t)};
1449	const auto &type = std::get<parser::TypeSpec>(spec.t);
1450	if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {
1451	context_.Say(dir.source, "Type is not a derived type"_err_en_US);
1452	}
1453	}
1454
1455	void OmpStructureChecker::Leave(const parser::OpenMPDeclareMapperConstruct &) {
1456	dirContext_.pop_back();
1457	}
1458
1459	void OmpStructureChecker::Enter(
1460	const parser::OpenMPDeclareReductionConstruct &x) {
1461	const auto &dir{std::get<parser::Verbatim>(x.t)};
1462	PushContextAndClauseSets(
1463	dir.source, llvm::omp::Directive::OMPD_declare_reduction);
1464	}
1465
1466	void OmpStructureChecker::Leave(
1467	const parser::OpenMPDeclareReductionConstruct &) {
1468	dirContext_.pop_back();
1469	}
1470
1471	void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
1472	const auto &dir{std::get<parser::Verbatim>(x.t)};
1473	PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);
1474	}
1475
1476	void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) {
1477	SymbolSourceMap symbols;
1478	GetSymbolsInObjectList(x.v, symbols);
1479	for (auto &[symbol, source] : symbols) {
1480	const GenericDetails *genericDetails = symbol->detailsIf<GenericDetails>();
1481	if (genericDetails) {
1482	context_.Say(source,
1483	"The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US,
1484	symbol->name());
1485	genericDetails->specific();
1486	}
1487	if (IsProcedurePointer(*symbol)) {
1488	context_.Say(source,
1489	"The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US,
1490	symbol->name());
1491	}
1492	const SubprogramDetails *entryDetails =
1493	symbol->detailsIf<SubprogramDetails>();
1494	if (entryDetails && entryDetails->entryScope()) {
1495	context_.Say(source,
1496	"The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US,
1497	symbol->name());
1498	}
1499	if (IsStmtFunction(*symbol)) {
1500	context_.Say(source,
1501	"The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US,
1502	symbol->name());
1503	}
1504	}
1505	}
1506
1507	void OmpStructureChecker::CheckSymbolNames(
1508	const parser::CharBlock &source, const parser::OmpObjectList &objList) {
1509	for (const auto &ompObject : objList.v) {
1510	common::visit(
1511	common::visitors{
1512	[&](const parser::Designator &designator) {
1513	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
1514	if (!name->symbol) {
1515	context_.Say(source,
1516	"The given %s directive clause has an invalid argument"_err_en_US,
1517	ContextDirectiveAsFortran());
1518	}
1519	}
1520	},
1521	[&](const parser::Name &name) {
1522	if (!name.symbol) {
1523	context_.Say(source,
1524	"The given %s directive clause has an invalid argument"_err_en_US,
1525	ContextDirectiveAsFortran());
1526	}
1527	},
1528	},
1529	ompObject.u);
1530	}
1531	}
1532
1533	void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {
1534	const auto &dir{std::get<parser::Verbatim>(x.t)};
1535	const auto &spec{std::get<parser::OmpDeclareTargetSpecifier>(x.t)};
1536	// Handle both forms of DECLARE TARGET.
1537	// - Extended list: It behaves as if there was an ENTER/TO clause with the
1538	// list of objects as argument. It accepts no explicit clauses.
1539	// - With clauses.
1540	if (const auto *objectList{parser::Unwrap<parser::OmpObjectList>(spec.u)}) {
1541	deviceConstructFound_ = true;
1542	CheckSymbolNames(dir.source, *objectList);
1543	CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
1544	CheckThreadprivateOrDeclareTargetVar(*objectList);
1545	} else if (const auto *clauseList{
1546	parser::Unwrap<parser::OmpClauseList>(spec.u)}) {
1547	bool toClauseFound{false}, deviceTypeClauseFound{false},
1548	enterClauseFound{false};
1549	for (const auto &clause : clauseList->v) {
1550	common::visit(
1551	common::visitors{
1552	[&](const parser::OmpClause::To &toClause) {
1553	toClauseFound = true;
1554	auto &objList{std::get<parser::OmpObjectList>(toClause.v.t)};
1555	CheckSymbolNames(dir.source, objList);
1556	CheckVarIsNotPartOfAnotherVar(dir.source, objList);
1557	CheckThreadprivateOrDeclareTargetVar(objList);
1558	},
1559	[&](const parser::OmpClause::Link &linkClause) {
1560	CheckSymbolNames(dir.source, linkClause.v);
1561	CheckVarIsNotPartOfAnotherVar(dir.source, linkClause.v);
1562	CheckThreadprivateOrDeclareTargetVar(linkClause.v);
1563	},
1564	[&](const parser::OmpClause::Enter &enterClause) {
1565	enterClauseFound = true;
1566	CheckSymbolNames(dir.source, enterClause.v);
1567	CheckVarIsNotPartOfAnotherVar(dir.source, enterClause.v);
1568	CheckThreadprivateOrDeclareTargetVar(enterClause.v);
1569	},
1570	[&](const parser::OmpClause::DeviceType &deviceTypeClause) {
1571	deviceTypeClauseFound = true;
1572	if (deviceTypeClause.v.v !=
1573	parser::OmpDeviceTypeClause::DeviceTypeDescription::Host) {
1574	// Function / subroutine explicitly marked as runnable by the
1575	// target device.
1576	deviceConstructFound_ = true;
1577	}
1578	},
1579	[&](const auto &) {},
1580	},
1581	clause.u);
1582
1583	if ((toClauseFound || enterClauseFound) && !deviceTypeClauseFound) {
1584	deviceConstructFound_ = true;
1585	}
1586	}
1587	}
1588	dirContext_.pop_back();
1589	}
1590
1591	void OmpStructureChecker::Enter(const parser::OmpErrorDirective &x) {
1592	const auto &dir{std::get<parser::Verbatim>(x.t)};
1593	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_error);
1594	}
1595
1596	void OmpStructureChecker::Enter(const parser::OpenMPDispatchConstruct &x) {
1597	auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
1598	const auto &block{std::get<parser::Block>(x.t)};
1599	PushContextAndClauseSets(
1600	dirSpec.DirName().source, llvm::omp::Directive::OMPD_dispatch);
1601
1602	if (block.empty()) {
1603	context_.Say(x.source,
1604	"The DISPATCH construct should contain a single function or subroutine call"_err_en_US);
1605	return;
1606	}
1607
1608	bool passChecks{false};
1609	omp::SourcedActionStmt action{omp::GetActionStmt(block)};
1610	if (const auto *assignStmt{
1611	parser::Unwrap<parser::AssignmentStmt>(*action.stmt)}) {
1612	if (parser::Unwrap<parser::FunctionReference>(assignStmt->t)) {
1613	passChecks = true;
1614	}
1615	} else if (parser::Unwrap<parser::CallStmt>(*action.stmt)) {
1616	passChecks = true;
1617	}
1618
1619	if (!passChecks) {
1620	context_.Say(action.source,
1621	"The body of the DISPATCH construct should be a function or a subroutine call"_err_en_US);
1622	}
1623	}
1624
1625	void OmpStructureChecker::Leave(const parser::OpenMPDispatchConstruct &x) {
1626	dirContext_.pop_back();
1627	}
1628
1629	void OmpStructureChecker::Leave(const parser::OmpErrorDirective &x) {
1630	dirContext_.pop_back();
1631	}
1632
1633	void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
1634	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_at);
1635	if (GetDirectiveNest(index: DeclarativeNest) > 0) {
1636	if (x.v.v == parser::OmpAtClause::ActionTime::Execution) {
1637	context_.Say(GetContext().clauseSource,
1638	"The ERROR directive with AT(EXECUTION) cannot appear in the specification part"_err_en_US);
1639	}
1640	}
1641	}
1642
1643	void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
1644	isPredefinedAllocator = true;
1645	const auto &dir{std::get<parser::Verbatim>(x.t)};
1646	const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1647	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
1648	const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
1649	for (const auto &clause : clauseList.v) {
1650	CheckAlignValue(clause);
1651	}
1652	if (objectList) {
1653	CheckVarIsNotPartOfAnotherVar(dir.source, *objectList);
1654	}
1655	}
1656
1657	void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
1658	const auto &dir{std::get<parser::Verbatim>(x.t)};
1659	const auto &objectList{std::get<std::optional<parser::OmpObjectList>>(x.t)};
1660	if (objectList)
1661	CheckPredefinedAllocatorRestriction(dir.source, *objectList);
1662	dirContext_.pop_back();
1663	}
1664
1665	void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
1666	isPredefinedAllocator = true;
1667
1668	auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
1669	auto &block{std::get<parser::Block>(x.t)};
1670	PushContextAndClauseSets(
1671	dirSpec.DirName().source, llvm::omp::Directive::OMPD_allocators);
1672
1673	if (block.empty()) {
1674	context_.Say(dirSpec.source,
1675	"The ALLOCATORS construct should contain a single ALLOCATE statement"_err_en_US);
1676	return;
1677	}
1678
1679	omp::SourcedActionStmt action{omp::GetActionStmt(block)};
1680	const auto *allocate{
1681	action ? parser::Unwrap<parser::AllocateStmt>(action.stmt) : nullptr};
1682
1683	if (!allocate) {
1684	const parser::CharBlock &source = action ? action.source : x.source;
1685	context_.Say(source,
1686	"The body of the ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);
1687	}
1688
1689	for (const auto &clause : dirSpec.Clauses().v) {
1690	if (const auto *allocClause{
1691	parser::Unwrap<parser::OmpClause::Allocate>(clause)}) {
1692	CheckVarIsNotPartOfAnotherVar(
1693	dirSpec.source, std::get<parser::OmpObjectList>(allocClause->v.t));
1694	}
1695	}
1696	}
1697
1698	void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {
1699	auto &dirSpec{std::get<parser::OmpDirectiveSpecification>(x.t)};
1700
1701	for (const auto &clause : dirSpec.Clauses().v) {
1702	if (const auto *allocClause{
1703	std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
1704	CheckPredefinedAllocatorRestriction(
1705	dirSpec.source, std::get<parser::OmpObjectList>(allocClause->v.t));
1706	}
1707	}
1708	dirContext_.pop_back();
1709	}
1710
1711	void OmpStructureChecker::CheckScan(
1712	const parser::OpenMPSimpleStandaloneConstruct &x) {
1713	if (x.v.Clauses().v.size() != 1) {
1714	context_.Say(x.source,
1715	"Exactly one of EXCLUSIVE or INCLUSIVE clause is expected"_err_en_US);
1716	}
1717	if (!CurrentDirectiveIsNested() ||
1718	!llvm::omp::scanParentAllowedSet.test(GetContextParent().directive)) {
1719	context_.Say(x.source,
1720	"Orphaned SCAN directives are prohibited; perhaps you forgot "
1721	"to enclose the directive in to a WORKSHARING LOOP, a WORKSHARING "
1722	"LOOP SIMD or a SIMD directive."_err_en_US);
1723	}
1724	}
1725
1726	void OmpStructureChecker::CheckBarrierNesting(
1727	const parser::OpenMPSimpleStandaloneConstruct &x) {
1728	// A barrier region may not be `closely nested` inside a worksharing, loop,
1729	// task, taskloop, critical, ordered, atomic, or master region.
1730	// TODO: Expand the check to include `LOOP` construct as well when it is
1731	// supported.
1732	if (IsCloselyNestedRegion(llvm::omp::nestedBarrierErrSet)) {
1733	context_.Say(parser::FindSourceLocation(x),
1734	"`BARRIER` region may not be closely nested inside of `WORKSHARING`, "
1735	"`LOOP`, `TASK`, `TASKLOOP`,"
1736	"`CRITICAL`, `ORDERED`, `ATOMIC` or `MASTER` region."_err_en_US);
1737	}
1738	}
1739
1740	void OmpStructureChecker::ChecksOnOrderedAsStandalone() {
1741	if (FindClause(llvm::omp::Clause::OMPC_threads) ||
1742	FindClause(llvm::omp::Clause::OMPC_simd)) {
1743	context_.Say(GetContext().clauseSource,
1744	"THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
1745	}
1746
1747	int dependSinkCount{0}, dependSourceCount{0};
1748	bool exclusiveShown{false}, duplicateSourceShown{false};
1749
1750	auto visitDoacross{[&](const parser::OmpDoacross &doa,
1751	const parser::CharBlock &src) {
1752	common::visit(
1753	common::visitors{
1754	[&](const parser::OmpDoacross::Source &) { dependSourceCount++; },
1755	[&](const parser::OmpDoacross::Sink &) { dependSinkCount++; }},
1756	doa.u);
1757	if (!exclusiveShown && dependSinkCount > 0 && dependSourceCount > 0) {
1758	exclusiveShown = true;
1759	context_.Say(src,
1760	"The SINK and SOURCE dependence types are mutually exclusive"_err_en_US);
1761	}
1762	if (!duplicateSourceShown && dependSourceCount > 1) {
1763	duplicateSourceShown = true;
1764	context_.Say(src,
1765	"At most one SOURCE dependence type can appear on the ORDERED directive"_err_en_US);
1766	}
1767	}};
1768
1769	// Visit the DEPEND and DOACROSS clauses.
1770	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
1771	const auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
1772	if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
1773	visitDoacross(*doAcross, clause->source);
1774	} else {
1775	context_.Say(clause->source,
1776	"Only SINK or SOURCE dependence types are allowed when ORDERED construct is a standalone construct with no ORDERED region"_err_en_US);
1777	}
1778	}
1779	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
1780	auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
1781	visitDoacross(doaClause.v.v, clause->source);
1782	}
1783
1784	bool isNestedInDoOrderedWithPara{false};
1785	if (CurrentDirectiveIsNested() &&
1786	llvm::omp::nestedOrderedDoAllowedSet.test(GetContextParent().directive)) {
1787	if (const auto *clause{
1788	FindClause(GetContextParent(), llvm::omp::Clause::OMPC_ordered)}) {
1789	const auto &orderedClause{
1790	std::get<parser::OmpClause::Ordered>(clause->u)};
1791	const auto orderedValue{GetIntValue(orderedClause.v)};
1792	if (orderedValue > 0) {
1793	isNestedInDoOrderedWithPara = true;
1794	CheckOrderedDependClause(orderedValue: orderedValue);
1795	}
1796	}
1797	}
1798
1799	if (FindClause(llvm::omp::Clause::OMPC_depend) &&
1800	!isNestedInDoOrderedWithPara) {
1801	context_.Say(GetContext().clauseSource,
1802	"An ORDERED construct with the DEPEND clause must be closely nested "
1803	"in a worksharing-loop (or parallel worksharing-loop) construct with "
1804	"ORDERED clause with a parameter"_err_en_US);
1805	}
1806	}
1807
1808	void OmpStructureChecker::CheckOrderedDependClause(
1809	std::optional<int64_t> orderedValue) {
1810	auto visitDoacross{[&](const parser::OmpDoacross &doa,
1811	const parser::CharBlock &src) {
1812	if (auto *sinkVector{std::get_if<parser::OmpDoacross::Sink>(&doa.u)}) {
1813	int64_t numVar = sinkVector->v.v.size();
1814	if (orderedValue != numVar) {
1815	context_.Say(src,
1816	"The number of variables in the SINK iteration vector does not match the parameter specified in ORDERED clause"_err_en_US);
1817	}
1818	}
1819	}};
1820	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_depend)) {
1821	auto &dependClause{std::get<parser::OmpClause::Depend>(clause->u)};
1822	if (auto *doAcross{std::get_if<parser::OmpDoacross>(&dependClause.v.u)}) {
1823	visitDoacross(*doAcross, clause->source);
1824	}
1825	}
1826	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_doacross)) {
1827	auto &doaClause{std::get<parser::OmpClause::Doacross>(clause->u)};
1828	visitDoacross(doaClause.v.v, clause->source);
1829	}
1830	}
1831
1832	void OmpStructureChecker::CheckTargetUpdate() {
1833	const parser::OmpClause *toWrapper{FindClause(llvm::omp::Clause::OMPC_to)};
1834	const parser::OmpClause *fromWrapper{
1835	FindClause(llvm::omp::Clause::OMPC_from)};
1836	if (!toWrapper && !fromWrapper) {
1837	context_.Say(GetContext().directiveSource,
1838	"At least one motion-clause (TO/FROM) must be specified on "
1839	"TARGET UPDATE construct."_err_en_US);
1840	}
1841	if (toWrapper && fromWrapper) {
1842	SymbolSourceMap toSymbols, fromSymbols;
1843	auto &fromClause{std::get<parser::OmpClause::From>(fromWrapper->u).v};
1844	auto &toClause{std::get<parser::OmpClause::To>(toWrapper->u).v};
1845	GetSymbolsInObjectList(
1846	std::get<parser::OmpObjectList>(fromClause.t), fromSymbols);
1847	GetSymbolsInObjectList(
1848	std::get<parser::OmpObjectList>(toClause.t), toSymbols);
1849
1850	for (auto &[symbol, source] : toSymbols) {
1851	auto fromSymbol{fromSymbols.find(symbol)};
1852	if (fromSymbol != fromSymbols.end()) {
1853	context_.Say(source,
1854	"A list item ('%s') can only appear in a TO or FROM clause, but not in both."_err_en_US,
1855	symbol->name());
1856	context_.Say(source, "'%s' appears in the TO clause."_because_en_US,
1857	symbol->name());
1858	context_.Say(fromSymbol->second,
1859	"'%s' appears in the FROM clause."_because_en_US,
1860	fromSymbol->first->name());
1861	}
1862	}
1863	}
1864	}
1865
1866	void OmpStructureChecker::CheckTaskDependenceType(
1867	const parser::OmpTaskDependenceType::Value &x) {
1868	// Common checks for task-dependence-type (DEPEND and UPDATE clauses).
1869	unsigned version{context_.langOptions().OpenMPVersion};
1870	unsigned since{0};
1871
1872	switch (x) {
1873	case parser::OmpTaskDependenceType::Value::In:
1874	case parser::OmpTaskDependenceType::Value::Out:
1875	case parser::OmpTaskDependenceType::Value::Inout:
1876	break;
1877	case parser::OmpTaskDependenceType::Value::Mutexinoutset:
1878	case parser::OmpTaskDependenceType::Value::Depobj:
1879	since = 50;
1880	break;
1881	case parser::OmpTaskDependenceType::Value::Inoutset:
1882	since = 52;
1883	break;
1884	}
1885
1886	if (version < since) {
1887	context_.Say(GetContext().clauseSource,
1888	"%s task dependence type is not supported in %s, %s"_warn_en_US,
1889	parser::ToUpperCaseLetters(
1890	parser::OmpTaskDependenceType::EnumToString(x)),
1891	ThisVersion(version), TryVersion(since));
1892	}
1893	}
1894
1895	void OmpStructureChecker::CheckDependenceType(
1896	const parser::OmpDependenceType::Value &x) {
1897	// Common checks for dependence-type (DEPEND and UPDATE clauses).
1898	unsigned version{context_.langOptions().OpenMPVersion};
1899	unsigned deprecatedIn{~0u};
1900
1901	switch (x) {
1902	case parser::OmpDependenceType::Value::Source:
1903	case parser::OmpDependenceType::Value::Sink:
1904	deprecatedIn = 52;
1905	break;
1906	}
1907
1908	if (version >= deprecatedIn) {
1909	context_.Say(GetContext().clauseSource,
1910	"%s dependence type is deprecated in %s"_warn_en_US,
1911	parser::ToUpperCaseLetters(parser::OmpDependenceType::EnumToString(x)),
1912	ThisVersion(deprecatedIn));
1913	}
1914	}
1915
1916	void OmpStructureChecker::Enter(
1917	const parser::OpenMPSimpleStandaloneConstruct &x) {
1918	const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};
1919	PushContextAndClauseSets(dir.source, dir.v);
1920	switch (dir.v) {
1921	case llvm::omp::Directive::OMPD_barrier:
1922	CheckBarrierNesting(x);
1923	break;
1924	case llvm::omp::Directive::OMPD_scan:
1925	CheckScan(x);
1926	break;
1927	default:
1928	break;
1929	}
1930	}
1931
1932	void OmpStructureChecker::Leave(
1933	const parser::OpenMPSimpleStandaloneConstruct &x) {
1934	switch (GetContext().directive) {
1935	case llvm::omp::Directive::OMPD_ordered:
1936	// [5.1] 2.19.9 Ordered Construct Restriction
1937	ChecksOnOrderedAsStandalone();
1938	break;
1939	case llvm::omp::Directive::OMPD_target_update:
1940	CheckTargetUpdate();
1941	break;
1942	default:
1943	break;
1944	}
1945	dirContext_.pop_back();
1946	}
1947
1948	void OmpStructureChecker::Enter(const parser::OpenMPFlushConstruct &x) {
1949	const auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
1950	PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_flush);
1951	}
1952
1953	void OmpStructureChecker::Leave(const parser::OpenMPFlushConstruct &x) {
1954	auto &flushList{std::get<std::optional<parser::OmpArgumentList>>(x.v.t)};
1955
1956	auto isVariableListItemOrCommonBlock{[](const Symbol &sym) {
1957	return IsVariableListItem(sym) ||
1958	sym.detailsIf<semantics::CommonBlockDetails>();
1959	}};
1960
1961	if (flushList) {
1962	for (const parser::OmpArgument &arg : flushList->v) {
1963	if (auto *sym{GetArgumentSymbol(arg)};
1964	sym && !isVariableListItemOrCommonBlock(*sym)) {
1965	context_.Say(arg.source,
1966	"FLUSH argument must be a variable list item"_err_en_US);
1967	}
1968	}
1969
1970	if (FindClause(llvm::omp::Clause::OMPC_acquire) ||
1971	FindClause(llvm::omp::Clause::OMPC_release) ||
1972	FindClause(llvm::omp::Clause::OMPC_acq_rel)) {
1973	context_.Say(flushList->source,
1974	"If memory-order-clause is RELEASE, ACQUIRE, or ACQ_REL, list items must not be specified on the FLUSH directive"_err_en_US);
1975	}
1976	}
1977
1978	unsigned version{context_.langOptions().OpenMPVersion};
1979	if (version >= 52) {
1980	using Flags = parser::OmpDirectiveSpecification::Flags;
1981	if (std::get<Flags>(x.v.t) == Flags::DeprecatedSyntax) {
1982	context_.Say(x.source,
1983	"The syntax \"FLUSH clause (object, ...)\" has been deprecated, use \"FLUSH(object, ...) clause\" instead"_warn_en_US);
1984	}
1985	}
1986
1987	dirContext_.pop_back();
1988	}
1989
1990	void OmpStructureChecker::Enter(const parser::OpenMPCancelConstruct &x) {
1991	auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
1992	auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
1993	PushContextAndClauseSets(dirName.source, llvm::omp::Directive::OMPD_cancel);
1994
1995	if (auto maybeConstruct{GetCancelType(
1996	llvm::omp::Directive::OMPD_cancel, x.source, maybeClauses)}) {
1997	CheckCancellationNest(dirName.source, *maybeConstruct);
1998
1999	if (CurrentDirectiveIsNested()) {
2000	// nowait can be put on the end directive rather than the start directive
2001	// so we need to check both
2002	auto getParentClauses{[&]() {
2003	const DirectiveContext &parent{GetContextParent()};
2004	return llvm::concat<const llvm::omp::Clause>(
2005	parent.actualClauses, parent.endDirectiveClauses);
2006	}};
2007
2008	if (llvm::omp::nestedCancelDoAllowedSet.test(*maybeConstruct)) {
2009	for (llvm::omp::Clause clause : getParentClauses()) {
2010	if (clause == llvm::omp::Clause::OMPC_nowait) {
2011	context_.Say(dirName.source,
2012	"The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);
2013	}
2014	if (clause == llvm::omp::Clause::OMPC_ordered) {
2015	context_.Say(dirName.source,
2016	"The CANCEL construct cannot be nested inside of a worksharing construct with the ORDERED clause"_err_en_US);
2017	}
2018	}
2019	} else if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2020	*maybeConstruct)) {
2021	for (llvm::omp::Clause clause : getParentClauses()) {
2022	if (clause == llvm::omp::Clause::OMPC_nowait) {
2023	context_.Say(dirName.source,
2024	"The CANCEL construct cannot be nested inside of a worksharing construct with the NOWAIT clause"_err_en_US);
2025	}
2026	}
2027	}
2028	}
2029	}
2030	}
2031
2032	void OmpStructureChecker::Leave(const parser::OpenMPCancelConstruct &) {
2033	dirContext_.pop_back();
2034	}
2035
2036	void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) {
2037	const auto &dir{std::get<parser::OmpCriticalDirective>(x.t)};
2038	const auto &dirSource{std::get<parser::Verbatim>(dir.t).source};
2039	const auto &endDir{std::get<parser::OmpEndCriticalDirective>(x.t)};
2040	PushContextAndClauseSets(dirSource, llvm::omp::Directive::OMPD_critical);
2041	const auto &block{std::get<parser::Block>(x.t)};
2042	CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source);
2043	const auto &dirName{std::get<std::optional<parser::Name>>(dir.t)};
2044	const auto &endDirName{std::get<std::optional<parser::Name>>(endDir.t)};
2045	const auto &ompClause{std::get<parser::OmpClauseList>(dir.t)};
2046	if (dirName && endDirName &&
2047	dirName->ToString().compare(endDirName->ToString())) {
2048	context_
2049	.Say(endDirName->source,
2050	parser::MessageFormattedText{
2051	"CRITICAL directive names do not match"_err_en_US})
2052	.Attach(dirName->source, "should be "_en_US);
2053	} else if (dirName && !endDirName) {
2054	context_
2055	.Say(dirName->source,
2056	parser::MessageFormattedText{
2057	"CRITICAL directive names do not match"_err_en_US})
2058	.Attach(dirName->source, "should be NULL"_en_US);
2059	} else if (!dirName && endDirName) {
2060	context_
2061	.Say(endDirName->source,
2062	parser::MessageFormattedText{
2063	"CRITICAL directive names do not match"_err_en_US})
2064	.Attach(endDirName->source, "should be NULL"_en_US);
2065	}
2066	if (!dirName && !ompClause.source.empty() &&
2067	ompClause.source.NULTerminatedToString() != "hint(omp_sync_hint_none)") {
2068	context_.Say(dir.source,
2069	parser::MessageFormattedText{
2070	"Hint clause other than omp_sync_hint_none cannot be specified for "
2071	"an unnamed CRITICAL directive"_err_en_US});
2072	}
2073	}
2074
2075	void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) {
2076	dirContext_.pop_back();
2077	}
2078
2079	void OmpStructureChecker::Enter(
2080	const parser::OmpClause::CancellationConstructType &x) {
2081	llvm::omp::Directive dir{GetContext().directive};
2082	auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2083
2084	if (dir != llvm::omp::Directive::OMPD_cancel &&
2085	dir != llvm::omp::Directive::OMPD_cancellation_point) {
2086	// Do not call CheckAllowed/CheckAllowedClause, because in case of an error
2087	// it will print "CANCELLATION_CONSTRUCT_TYPE" as the clause name instead
2088	// of the contained construct name.
2089	context_.Say(dirName.source, "%s cannot follow %s"_err_en_US,
2090	parser::ToUpperCaseLetters(getDirectiveName(dirName.v)),
2091	parser::ToUpperCaseLetters(getDirectiveName(dir)));
2092	} else {
2093	switch (dirName.v) {
2094	case llvm::omp::Directive::OMPD_do:
2095	case llvm::omp::Directive::OMPD_parallel:
2096	case llvm::omp::Directive::OMPD_sections:
2097	case llvm::omp::Directive::OMPD_taskgroup:
2098	break;
2099	default:
2100	context_.Say(dirName.source,
2101	"%s is not a cancellable construct"_err_en_US,
2102	parser::ToUpperCaseLetters(getDirectiveName(dirName.v)));
2103	break;
2104	}
2105	}
2106	}
2107
2108	void OmpStructureChecker::Enter(
2109	const parser::OpenMPCancellationPointConstruct &x) {
2110	auto &dirName{std::get<parser::OmpDirectiveName>(x.v.t)};
2111	auto &maybeClauses{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
2112	PushContextAndClauseSets(
2113	dirName.source, llvm::omp::Directive::OMPD_cancellation_point);
2114
2115	if (auto maybeConstruct{
2116	GetCancelType(llvm::omp::Directive::OMPD_cancellation_point, x.source,
2117	maybeClauses)}) {
2118	CheckCancellationNest(dirName.source, *maybeConstruct);
2119	}
2120	}
2121
2122	void OmpStructureChecker::Leave(
2123	const parser::OpenMPCancellationPointConstruct &) {
2124	dirContext_.pop_back();
2125	}
2126
2127	std::optional<llvm::omp::Directive> OmpStructureChecker::GetCancelType(
2128	llvm::omp::Directive cancelDir, const parser::CharBlock &cancelSource,
2129	const std::optional<parser::OmpClauseList> &maybeClauses) {
2130	if (!maybeClauses) {
2131	return std::nullopt;
2132	}
2133	// Given clauses from CANCEL or CANCELLATION_POINT, identify the construct
2134	// to which the cancellation applies.
2135	std::optional<llvm::omp::Directive> cancelee;
2136	llvm::StringRef cancelName{getDirectiveName(directive: cancelDir)};
2137
2138	for (const parser::OmpClause &clause : maybeClauses->v) {
2139	using CancellationConstructType =
2140	parser::OmpClause::CancellationConstructType;
2141	if (auto *cctype{std::get_if<CancellationConstructType>(&clause.u)}) {
2142	if (cancelee) {
2143	context_.Say(cancelSource,
2144	"Multiple cancel-directive-name clauses are not allowed on the %s construct"_err_en_US,
2145	parser::ToUpperCaseLetters(cancelName.str()));
2146	return std::nullopt;
2147	}
2148	cancelee = std::get<parser::OmpDirectiveName>(cctype->v.t).v;
2149	}
2150	}
2151
2152	if (!cancelee) {
2153	context_.Say(cancelSource,
2154	"Missing cancel-directive-name clause on the %s construct"_err_en_US,
2155	parser::ToUpperCaseLetters(cancelName.str()));
2156	return std::nullopt;
2157	}
2158
2159	return cancelee;
2160	}
2161
2162	void OmpStructureChecker::CheckCancellationNest(
2163	const parser::CharBlock &source, llvm::omp::Directive type) {
2164	llvm::StringRef typeName{getDirectiveName(directive: type)};
2165
2166	if (CurrentDirectiveIsNested()) {
2167	// If construct-type-clause is taskgroup, the cancellation construct must be
2168	// closely nested inside a task or a taskloop construct and the cancellation
2169	// region must be closely nested inside a taskgroup region. If
2170	// construct-type-clause is sections, the cancellation construct must be
2171	// closely nested inside a sections or section construct. Otherwise, the
2172	// cancellation construct must be closely nested inside an OpenMP construct
2173	// that matches the type specified in construct-type-clause of the
2174	// cancellation construct.
2175	bool eligibleCancellation{false};
2176
2177	switch (type) {
2178	case llvm::omp::Directive::OMPD_taskgroup:
2179	if (llvm::omp::nestedCancelTaskgroupAllowedSet.test(
2180	GetContextParent().directive)) {
2181	eligibleCancellation = true;
2182	if (dirContext_.size() >= 3) {
2183	// Check if the cancellation region is closely nested inside a
2184	// taskgroup region when there are more than two levels of directives
2185	// in the directive context stack.
2186	if (GetContextParent().directive == llvm::omp::Directive::OMPD_task ||
2187	FindClauseParent(llvm::omp::Clause::OMPC_nogroup)) {
2188	for (int i = dirContext_.size() - 3; i >= 0; i--) {
2189	if (dirContext_[i].directive ==
2190	llvm::omp::Directive::OMPD_taskgroup) {
2191	break;
2192	}
2193	if (llvm::omp::nestedCancelParallelAllowedSet.test(
2194	dirContext_[i].directive)) {
2195	eligibleCancellation = false;
2196	break;
2197	}
2198	}
2199	}
2200	}
2201	}
2202	if (!eligibleCancellation) {
2203	context_.Say(source,
2204	"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,
2205	parser::ToUpperCaseLetters(typeName.str()),
2206	ContextDirectiveAsFortran(), ContextDirectiveAsFortran());
2207	}
2208	return;
2209	case llvm::omp::Directive::OMPD_sections:
2210	if (llvm::omp::nestedCancelSectionsAllowedSet.test(
2211	GetContextParent().directive)) {
2212	eligibleCancellation = true;
2213	}
2214	break;
2215	case llvm::omp::Directive::OMPD_do:
2216	if (llvm::omp::nestedCancelDoAllowedSet.test(
2217	GetContextParent().directive)) {
2218	eligibleCancellation = true;
2219	}
2220	break;
2221	case llvm::omp::Directive::OMPD_parallel:
2222	if (llvm::omp::nestedCancelParallelAllowedSet.test(
2223	GetContextParent().directive)) {
2224	eligibleCancellation = true;
2225	}
2226	break;
2227	default:
2228	// This is diagnosed later.
2229	return;
2230	}
2231	if (!eligibleCancellation) {
2232	context_.Say(source,
2233	"With %s clause, %s construct cannot be closely nested inside %s construct"_err_en_US,
2234	parser::ToUpperCaseLetters(typeName.str()),
2235	ContextDirectiveAsFortran(),
2236	parser::ToUpperCaseLetters(
2237	getDirectiveName(GetContextParent().directive).str()));
2238	}
2239	} else {
2240	// The cancellation directive cannot be orphaned.
2241	switch (type) {
2242	case llvm::omp::Directive::OMPD_taskgroup:
2243	context_.Say(source,
2244	"%s %s directive is not closely nested inside TASK or TASKLOOP"_err_en_US,
2245	ContextDirectiveAsFortran(),
2246	parser::ToUpperCaseLetters(typeName.str()));
2247	break;
2248	case llvm::omp::Directive::OMPD_sections:
2249	context_.Say(source,
2250	"%s %s directive is not closely nested inside SECTION or SECTIONS"_err_en_US,
2251	ContextDirectiveAsFortran(),
2252	parser::ToUpperCaseLetters(typeName.str()));
2253	break;
2254	case llvm::omp::Directive::OMPD_do:
2255	context_.Say(source,
2256	"%s %s directive is not closely nested inside the construct that matches the DO clause type"_err_en_US,
2257	ContextDirectiveAsFortran(),
2258	parser::ToUpperCaseLetters(typeName.str()));
2259	break;
2260	case llvm::omp::Directive::OMPD_parallel:
2261	context_.Say(source,
2262	"%s %s directive is not closely nested inside the construct that matches the PARALLEL clause type"_err_en_US,
2263	ContextDirectiveAsFortran(),
2264	parser::ToUpperCaseLetters(typeName.str()));
2265	break;
2266	default:
2267	// This is diagnosed later.
2268	return;
2269	}
2270	}
2271	}
2272
2273	void OmpStructureChecker::Enter(const parser::OmpEndBlockDirective &x) {
2274	const auto &dir{std::get<parser::OmpBlockDirective>(x.t)};
2275	ResetPartialContext(dir.source);
2276	switch (dir.v) {
2277	case llvm::omp::Directive::OMPD_scope:
2278	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_scope);
2279	break;
2280	// 2.7.3 end-single-clause -> copyprivate-clause |
2281	// nowait-clause
2282	case llvm::omp::Directive::OMPD_single:
2283	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_end_single);
2284	break;
2285	// 2.7.4 end-workshare -> END WORKSHARE [nowait-clause]
2286	case llvm::omp::Directive::OMPD_workshare:
2287	PushContextAndClauseSets(
2288	dir.source, llvm::omp::Directive::OMPD_end_workshare);
2289	break;
2290	default:
2291	// no clauses are allowed
2292	break;
2293	}
2294	}
2295
2296	// TODO: Verify the popping of dirContext requirement after nowait
2297	// implementation, as there is an implicit barrier at the end of the worksharing
2298	// constructs unless a nowait clause is specified. Only OMPD_end_single and
2299	// end_workshareare popped as they are pushed while entering the
2300	// EndBlockDirective.
2301	void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
2302	if ((GetContext().directive == llvm::omp::Directive::OMPD_end_scope) ||
2303	(GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
2304	(GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
2305	dirContext_.pop_back();
2306	}
2307	}
2308
2309	// Clauses
2310	// Mainly categorized as
2311	// 1. Checks on 'OmpClauseList' from 'parse-tree.h'.
2312	// 2. Checks on clauses which fall under 'struct OmpClause' from parse-tree.h.
2313	// 3. Checks on clauses which are not in 'struct OmpClause' from parse-tree.h.
2314
2315	void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
2316	// 2.7.1 Loop Construct Restriction
2317	if (llvm::omp::allDoSet.test(GetContext().directive)) {
2318	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_schedule)}) {
2319	// only one schedule clause is allowed
2320	const auto &schedClause{std::get<parser::OmpClause::Schedule>(clause->u)};
2321	auto &modifiers{OmpGetModifiers(schedClause.v)};
2322	auto *ordering{
2323	OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};
2324	if (ordering &&
2325	ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {
2326	if (FindClause(llvm::omp::Clause::OMPC_ordered)) {
2327	context_.Say(clause->source,
2328	"The NONMONOTONIC modifier cannot be specified "
2329	"if an ORDERED clause is specified"_err_en_US);
2330	}
2331	}
2332	}
2333
2334	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_ordered)}) {
2335	// only one ordered clause is allowed
2336	const auto &orderedClause{
2337	std::get<parser::OmpClause::Ordered>(clause->u)};
2338
2339	if (orderedClause.v) {
2340	CheckNotAllowedIfClause(
2341	llvm::omp::Clause::OMPC_ordered, {llvm::omp::Clause::OMPC_linear});
2342
2343	if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_collapse)}) {
2344	const auto &collapseClause{
2345	std::get<parser::OmpClause::Collapse>(clause2->u)};
2346	// ordered and collapse both have parameters
2347	if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
2348	if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
2349	if (*orderedValue > 0 && *orderedValue < *collapseValue) {
2350	context_.Say(clause->source,
2351	"The parameter of the ORDERED clause must be "
2352	"greater than or equal to "
2353	"the parameter of the COLLAPSE clause"_err_en_US);
2354	}
2355	}
2356	}
2357	}
2358	}
2359
2360	// TODO: ordered region binding check (requires nesting implementation)
2361	}
2362	} // doSet
2363
2364	// 2.8.1 Simd Construct Restriction
2365	if (llvm::omp::allSimdSet.test(GetContext().directive)) {
2366	if (auto *clause{FindClause(llvm::omp::Clause::OMPC_simdlen)}) {
2367	if (auto *clause2{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
2368	const auto &simdlenClause{
2369	std::get<parser::OmpClause::Simdlen>(clause->u)};
2370	const auto &safelenClause{
2371	std::get<parser::OmpClause::Safelen>(clause2->u)};
2372	// simdlen and safelen both have parameters
2373	if (const auto simdlenValue{GetIntValue(simdlenClause.v)}) {
2374	if (const auto safelenValue{GetIntValue(safelenClause.v)}) {
2375	if (*safelenValue > 0 && *simdlenValue > *safelenValue) {
2376	context_.Say(clause->source,
2377	"The parameter of the SIMDLEN clause must be less than or "
2378	"equal to the parameter of the SAFELEN clause"_err_en_US);
2379	}
2380	}
2381	}
2382	}
2383	}
2384
2385	// 2.11.5 Simd construct restriction (OpenMP 5.1)
2386	if (auto *sl_clause{FindClause(llvm::omp::Clause::OMPC_safelen)}) {
2387	if (auto *o_clause{FindClause(llvm::omp::Clause::OMPC_order)}) {
2388	const auto &orderClause{
2389	std::get<parser::OmpClause::Order>(o_clause->u)};
2390	if (std::get<parser::OmpOrderClause::Ordering>(orderClause.v.t) ==
2391	parser::OmpOrderClause::Ordering::Concurrent) {
2392	context_.Say(sl_clause->source,
2393	"The `SAFELEN` clause cannot appear in the `SIMD` directive "
2394	"with `ORDER(CONCURRENT)` clause"_err_en_US);
2395	}
2396	}
2397	}
2398	} // SIMD
2399
2400	// Semantic checks related to presence of multiple list items within the same
2401	// clause
2402	CheckMultListItems();
2403
2404	if (GetContext().directive == llvm::omp::Directive::OMPD_task) {
2405	if (auto *detachClause{FindClause(llvm::omp::Clause::OMPC_detach)}) {
2406	unsigned version{context_.langOptions().OpenMPVersion};
2407	if (version == 50 || version == 51) {
2408	// OpenMP 5.0: 2.10.1 Task construct restrictions
2409	CheckNotAllowedIfClause(llvm::omp::Clause::OMPC_detach,
2410	{llvm::omp::Clause::OMPC_mergeable});
2411	} else if (version >= 52) {
2412	// OpenMP 5.2: 12.5.2 Detach construct restrictions
2413	if (FindClause(llvm::omp::Clause::OMPC_final)) {
2414	context_.Say(GetContext().clauseSource,
2415	"If a DETACH clause appears on a directive, then the encountering task must not be a FINAL task"_err_en_US);
2416	}
2417
2418	const auto &detach{
2419	std::get<parser::OmpClause::Detach>(detachClause->u)};
2420	if (const auto *name{parser::Unwrap<parser::Name>(detach.v.v)}) {
2421	Symbol *eventHandleSym{name->symbol};
2422	auto checkVarAppearsInDataEnvClause = [&](const parser::OmpObjectList
2423	&objs,
2424	std::string clause) {
2425	for (const auto &obj : objs.v) {
2426	if (const parser::Name *
2427	objName{parser::Unwrap<parser::Name>(obj)}) {
2428	if (&objName->symbol->GetUltimate() == eventHandleSym) {
2429	context_.Say(GetContext().clauseSource,
2430	"A variable: `%s` that appears in a DETACH clause cannot appear on %s clause on the same construct"_err_en_US,
2431	objName->source, clause);
2432	}
2433	}
2434	}
2435	};
2436	if (auto *dataEnvClause{
2437	FindClause(llvm::omp::Clause::OMPC_private)}) {
2438	const auto &pClause{
2439	std::get<parser::OmpClause::Private>(dataEnvClause->u)};
2440	checkVarAppearsInDataEnvClause(pClause.v, "PRIVATE");
2441	} else if (auto *dataEnvClause{
2442	FindClause(llvm::omp::Clause::OMPC_shared)}) {
2443	const auto &sClause{
2444	std::get<parser::OmpClause::Shared>(dataEnvClause->u)};
2445	checkVarAppearsInDataEnvClause(sClause.v, "SHARED");
2446	} else if (auto *dataEnvClause{
2447	FindClause(llvm::omp::Clause::OMPC_firstprivate)}) {
2448	const auto &fpClause{
2449	std::get<parser::OmpClause::Firstprivate>(dataEnvClause->u)};
2450	checkVarAppearsInDataEnvClause(fpClause.v, "FIRSTPRIVATE");
2451	} else if (auto *dataEnvClause{
2452	FindClause(llvm::omp::Clause::OMPC_in_reduction)}) {
2453	const auto &irClause{
2454	std::get<parser::OmpClause::InReduction>(dataEnvClause->u)};
2455	checkVarAppearsInDataEnvClause(
2456	std::get<parser::OmpObjectList>(irClause.v.t), "IN_REDUCTION");
2457	}
2458	}
2459	}
2460	}
2461	}
2462
2463	auto testThreadprivateVarErr = [&](Symbol sym, parser::Name name,
2464	llvmOmpClause clauseTy) {
2465	if (sym.test(Symbol::Flag::OmpThreadprivate))
2466	context_.Say(name.source,
2467	"A THREADPRIVATE variable cannot be in %s clause"_err_en_US,
2468	parser::ToUpperCaseLetters(getClauseName(clauseTy).str()));
2469	};
2470
2471	// [5.1] 2.21.2 Threadprivate Directive Restriction
2472	OmpClauseSet threadprivateAllowedSet{llvm::omp::Clause::OMPC_copyin,
2473	llvm::omp::Clause::OMPC_copyprivate, llvm::omp::Clause::OMPC_schedule,
2474	llvm::omp::Clause::OMPC_num_threads, llvm::omp::Clause::OMPC_thread_limit,
2475	llvm::omp::Clause::OMPC_if};
2476	for (auto it : GetContext().clauseInfo) {
2477	llvmOmpClause type = it.first;
2478	const auto *clause = it.second;
2479	if (!threadprivateAllowedSet.test(type)) {
2480	if (const auto *objList{GetOmpObjectList(*clause)}) {
2481	for (const auto &ompObject : objList->v) {
2482	common::visit(
2483	common::visitors{
2484	[&](const parser::Designator &) {
2485	if (const auto *name{
2486	parser::Unwrap<parser::Name>(ompObject)}) {
2487	if (name->symbol) {
2488	testThreadprivateVarErr(
2489	name->symbol->GetUltimate(), *name, type);
2490	}
2491	}
2492	},
2493	[&](const parser::Name &name) {
2494	if (name.symbol) {
2495	for (const auto &mem :
2496	name.symbol->get<CommonBlockDetails>().objects()) {
2497	testThreadprivateVarErr(mem->GetUltimate(), name, type);
2498	break;
2499	}
2500	}
2501	},
2502	},
2503	ompObject.u);
2504	}
2505	}
2506	}
2507	}
2508
2509	CheckRequireAtLeastOneOf();
2510	}
2511
2512	void OmpStructureChecker::Enter(const parser::OmpClause &x) {
2513	SetContextClause(x);
2514
2515	// The visitors for these clauses do their own checks.
2516	switch (x.Id()) {
2517	case llvm::omp::Clause::OMPC_copyprivate:
2518	case llvm::omp::Clause::OMPC_enter:
2519	case llvm::omp::Clause::OMPC_lastprivate:
2520	case llvm::omp::Clause::OMPC_reduction:
2521	case llvm::omp::Clause::OMPC_to:
2522	return;
2523	default:
2524	break;
2525	}
2526
2527	if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) {
2528	SymbolSourceMap symbols;
2529	GetSymbolsInObjectList(*objList, symbols);
2530	for (const auto &[symbol, source] : symbols) {
2531	if (!IsVariableListItem(*symbol)) {
2532	deferredNonVariables_.insert({symbol, source});
2533	}
2534	}
2535	}
2536	}
2537
2538	// Following clauses do not have a separate node in parse-tree.h.
2539	CHECK_SIMPLE_CLAUSE(Absent, OMPC_absent)
2540	CHECK_SIMPLE_CLAUSE(Affinity, OMPC_affinity)
2541	CHECK_SIMPLE_CLAUSE(Capture, OMPC_capture)
2542	CHECK_SIMPLE_CLAUSE(Contains, OMPC_contains)
2543	CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
2544	CHECK_SIMPLE_CLAUSE(Depobj, OMPC_depobj)
2545	CHECK_SIMPLE_CLAUSE(DeviceType, OMPC_device_type)
2546	CHECK_SIMPLE_CLAUSE(DistSchedule, OMPC_dist_schedule)
2547	CHECK_SIMPLE_CLAUSE(Exclusive, OMPC_exclusive)
2548	CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
2549	CHECK_SIMPLE_CLAUSE(Flush, OMPC_flush)
2550	CHECK_SIMPLE_CLAUSE(Full, OMPC_full)
2551	CHECK_SIMPLE_CLAUSE(Grainsize, OMPC_grainsize)
2552	CHECK_SIMPLE_CLAUSE(Holds, OMPC_holds)
2553	CHECK_SIMPLE_CLAUSE(Inclusive, OMPC_inclusive)
2554	CHECK_SIMPLE_CLAUSE(Initializer, OMPC_initializer)
2555	CHECK_SIMPLE_CLAUSE(Match, OMPC_match)
2556	CHECK_SIMPLE_CLAUSE(Nontemporal, OMPC_nontemporal)
2557	CHECK_SIMPLE_CLAUSE(NumTasks, OMPC_num_tasks)
2558	CHECK_SIMPLE_CLAUSE(Order, OMPC_order)
2559	CHECK_SIMPLE_CLAUSE(Read, OMPC_read)
2560	CHECK_SIMPLE_CLAUSE(Threadprivate, OMPC_threadprivate)
2561	CHECK_SIMPLE_CLAUSE(Threads, OMPC_threads)
2562	CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
2563	CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
2564	CHECK_SIMPLE_CLAUSE(Indirect, OMPC_indirect)
2565	CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
2566	CHECK_SIMPLE_CLAUSE(NoOpenmp, OMPC_no_openmp)
2567	CHECK_SIMPLE_CLAUSE(NoOpenmpRoutines, OMPC_no_openmp_routines)
2568	CHECK_SIMPLE_CLAUSE(NoOpenmpConstructs, OMPC_no_openmp_constructs)
2569	CHECK_SIMPLE_CLAUSE(NoParallelism, OMPC_no_parallelism)
2570	CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
2571	CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
2572	CHECK_SIMPLE_CLAUSE(Partial, OMPC_partial)
2573	CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
2574	CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
2575	CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
2576	CHECK_SIMPLE_CLAUSE(Permutation, OMPC_permutation)
2577	CHECK_SIMPLE_CLAUSE(Uniform, OMPC_uniform)
2578	CHECK_SIMPLE_CLAUSE(Unknown, OMPC_unknown)
2579	CHECK_SIMPLE_CLAUSE(Untied, OMPC_untied)
2580	CHECK_SIMPLE_CLAUSE(UsesAllocators, OMPC_uses_allocators)
2581	CHECK_SIMPLE_CLAUSE(Write, OMPC_write)
2582	CHECK_SIMPLE_CLAUSE(Init, OMPC_init)
2583	CHECK_SIMPLE_CLAUSE(Use, OMPC_use)
2584	CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants)
2585	CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext)
2586	CHECK_SIMPLE_CLAUSE(Severity, OMPC_severity)
2587	CHECK_SIMPLE_CLAUSE(Message, OMPC_message)
2588	CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter)
2589	CHECK_SIMPLE_CLAUSE(Otherwise, OMPC_otherwise)
2590	CHECK_SIMPLE_CLAUSE(AdjustArgs, OMPC_adjust_args)
2591	CHECK_SIMPLE_CLAUSE(AppendArgs, OMPC_append_args)
2592	CHECK_SIMPLE_CLAUSE(MemoryOrder, OMPC_memory_order)
2593	CHECK_SIMPLE_CLAUSE(Bind, OMPC_bind)
2594	CHECK_SIMPLE_CLAUSE(Align, OMPC_align)
2595	CHECK_SIMPLE_CLAUSE(Compare, OMPC_compare)
2596	CHECK_SIMPLE_CLAUSE(OmpxAttribute, OMPC_ompx_attribute)
2597	CHECK_SIMPLE_CLAUSE(Weak, OMPC_weak)
2598	CHECK_SIMPLE_CLAUSE(AcqRel, OMPC_acq_rel)
2599	CHECK_SIMPLE_CLAUSE(Acquire, OMPC_acquire)
2600	CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
2601	CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
2602	CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
2603	CHECK_SIMPLE_CLAUSE(Fail, OMPC_fail)
2604
2605	CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams)
2606	CHECK_REQ_SCALAR_INT_CLAUSE(NumThreads, OMPC_num_threads)
2607	CHECK_REQ_SCALAR_INT_CLAUSE(OmpxDynCgroupMem, OMPC_ompx_dyn_cgroup_mem)
2608	CHECK_REQ_SCALAR_INT_CLAUSE(Priority, OMPC_priority)
2609	CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
2610
2611	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
2612	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
2613	CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
2614
2615	// Restrictions specific to each clause are implemented apart from the
2616	// generalized restrictions.
2617
2618	void OmpStructureChecker::Enter(const parser::OmpClause::Destroy &x) {
2619	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_destroy);
2620
2621	llvm::omp::Directive dir{GetContext().directive};
2622	unsigned version{context_.langOptions().OpenMPVersion};
2623	if (dir == llvm::omp::Directive::OMPD_depobj) {
2624	unsigned argSince{52}, noargDeprecatedIn{52};
2625	if (x.v) {
2626	if (version < argSince) {
2627	context_.Say(GetContext().clauseSource,
2628	"The object parameter in DESTROY clause on DEPOPJ construct is not allowed in %s, %s"_warn_en_US,
2629	ThisVersion(version), TryVersion(argSince));
2630	}
2631	} else {
2632	if (version >= noargDeprecatedIn) {
2633	context_.Say(GetContext().clauseSource,
2634	"The DESTROY clause without argument on DEPOBJ construct is deprecated in %s"_warn_en_US,
2635	ThisVersion(noargDeprecatedIn));
2636	}
2637	}
2638	}
2639	}
2640
2641	void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
2642	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_reduction);
2643	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
2644
2645	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_reduction,
2646	GetContext().clauseSource, context_)) {
2647	auto &modifiers{OmpGetModifiers(x.v)};
2648	const auto *ident{
2649	OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
2650	assert(ident && "reduction-identifier is a required modifier");
2651	if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
2652	llvm::omp::OMPC_reduction)) {
2653	CheckReductionObjectTypes(objects, *ident);
2654	}
2655	using ReductionModifier = parser::OmpReductionModifier;
2656	if (auto *modifier{OmpGetUniqueModifier<ReductionModifier>(modifiers)}) {
2657	CheckReductionModifier(*modifier);
2658	}
2659	}
2660	CheckReductionObjects(objects, llvm::omp::Clause::OMPC_reduction);
2661
2662	// If this is a worksharing construct then ensure the reduction variable
2663	// is not private in the parallel region that it binds to.
2664	if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) {
2665	CheckSharedBindingInOuterContext(objects);
2666	}
2667
2668	if (GetContext().directive == llvm::omp::Directive::OMPD_loop) {
2669	for (auto clause : GetContext().clauseInfo) {
2670	if (const auto *bindClause{
2671	std::get_if<parser::OmpClause::Bind>(&clause.second->u)}) {
2672	if (bindClause->v.v == parser::OmpBindClause::Binding::Teams) {
2673	context_.Say(GetContext().clauseSource,
2674	"'REDUCTION' clause not allowed with '!$OMP LOOP BIND(TEAMS)'."_err_en_US);
2675	}
2676	}
2677	}
2678	}
2679	}
2680
2681	void OmpStructureChecker::Enter(const parser::OmpClause::InReduction &x) {
2682	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_in_reduction);
2683	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
2684
2685	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_in_reduction,
2686	GetContext().clauseSource, context_)) {
2687	auto &modifiers{OmpGetModifiers(x.v)};
2688	const auto *ident{
2689	OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
2690	assert(ident && "reduction-identifier is a required modifier");
2691	if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
2692	llvm::omp::OMPC_in_reduction)) {
2693	CheckReductionObjectTypes(objects, *ident);
2694	}
2695	}
2696	CheckReductionObjects(objects, llvm::omp::Clause::OMPC_in_reduction);
2697	}
2698
2699	void OmpStructureChecker::Enter(const parser::OmpClause::TaskReduction &x) {
2700	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_task_reduction);
2701	auto &objects{std::get<parser::OmpObjectList>(x.v.t)};
2702
2703	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_task_reduction,
2704	GetContext().clauseSource, context_)) {
2705	auto &modifiers{OmpGetModifiers(x.v)};
2706	const auto *ident{
2707	OmpGetUniqueModifier<parser::OmpReductionIdentifier>(modifiers)};
2708	assert(ident && "reduction-identifier is a required modifier");
2709	if (CheckReductionOperator(*ident, OmpGetModifierSource(modifiers, ident),
2710	llvm::omp::OMPC_task_reduction)) {
2711	CheckReductionObjectTypes(objects, *ident);
2712	}
2713	}
2714	CheckReductionObjects(objects, llvm::omp::Clause::OMPC_task_reduction);
2715	}
2716
2717	bool OmpStructureChecker::CheckReductionOperator(
2718	const parser::OmpReductionIdentifier &ident, parser::CharBlock source,
2719	llvm::omp::Clause clauseId) {
2720	auto visitOperator{[&](const parser::DefinedOperator &dOpr) {
2721	if (const auto *intrinsicOp{
2722	std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {
2723	switch (*intrinsicOp) {
2724	case parser::DefinedOperator::IntrinsicOperator::Add:
2725	case parser::DefinedOperator::IntrinsicOperator::Multiply:
2726	case parser::DefinedOperator::IntrinsicOperator::AND:
2727	case parser::DefinedOperator::IntrinsicOperator::OR:
2728	case parser::DefinedOperator::IntrinsicOperator::EQV:
2729	case parser::DefinedOperator::IntrinsicOperator::NEQV:
2730	return true;
2731	case parser::DefinedOperator::IntrinsicOperator::Subtract:
2732	context_.Say(GetContext().clauseSource,
2733	"The minus reduction operator is deprecated since OpenMP 5.2 and is not supported in the REDUCTION clause."_err_en_US,
2734	ContextDirectiveAsFortran());
2735	return false;
2736	default:
2737	break;
2738	}
2739	}
2740	// User-defined operators are OK if there has been a declared reduction
2741	// for that. We mangle those names to store the user details.
2742	if (const auto *definedOp{std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
2743	std::string mangled{MangleDefinedOperator(definedOp->v.symbol->name())};
2744	const Scope &scope{definedOp->v.symbol->owner()};
2745	if (const Symbol *symbol{scope.FindSymbol(mangled)}) {
2746	if (symbol->detailsIf<UserReductionDetails>()) {
2747	return true;
2748	}
2749	}
2750	}
2751	context_.Say(source, "Invalid reduction operator in %s clause."_err_en_US,
2752	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
2753	return false;
2754	}};
2755
2756	auto visitDesignator{[&](const parser::ProcedureDesignator &procD) {
2757	const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
2758	bool valid{false};
2759	if (name && name->symbol) {
2760	const SourceName &realName{name->symbol->GetUltimate().name()};
2761	valid =
2762	llvm::is_contained(Set: {"max", "min", "iand", "ior", "ieor"}, Element: realName);
2763	if (!valid) {
2764	valid = name->symbol->detailsIf<UserReductionDetails>();
2765	}
2766	}
2767	if (!valid) {
2768	context_.Say(source,
2769	"Invalid reduction identifier in %s clause."_err_en_US,
2770	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
2771	}
2772	return valid;
2773	}};
2774
2775	return common::visit(
2776	common::visitors{visitOperator, visitDesignator}, ident.u);
2777	}
2778
2779	/// Check restrictions on objects that are common to all reduction clauses.
2780	void OmpStructureChecker::CheckReductionObjects(
2781	const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
2782	unsigned version{context_.langOptions().OpenMPVersion};
2783	SymbolSourceMap symbols;
2784	GetSymbolsInObjectList(objects, symbols);
2785
2786	// Array sections must be a contiguous storage, have non-zero length.
2787	for (const parser::OmpObject &object : objects.v) {
2788	CheckIfContiguous(object);
2789	}
2790	CheckReductionArraySection(objects, clauseId);
2791	// An object must be definable.
2792	CheckDefinableObjects(symbols, clauseId);
2793	// Procedure pointers are not allowed.
2794	CheckProcedurePointer(symbols, clauseId);
2795	// Pointers must not have INTENT(IN).
2796	CheckIntentInPointer(symbols, clauseId);
2797
2798	// Disallow common blocks.
2799	// Iterate on objects because `GetSymbolsInObjectList` expands common block
2800	// names into the lists of their members.
2801	for (const parser::OmpObject &object : objects.v) {
2802	auto *symbol{GetObjectSymbol(object)};
2803	if (symbol && IsCommonBlock(*symbol)) {
2804	auto source{GetObjectSource(object)};
2805	context_.Say(source ? *source : GetContext().clauseSource,
2806	"Common block names are not allowed in %s clause"_err_en_US,
2807	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
2808	}
2809	}
2810
2811	// Denied in all current versions of the standard because structure components
2812	// are not definable (i.e. they are expressions not variables).
2813	// Object cannot be a part of another object (except array elements).
2814	CheckStructureComponent(objects, clauseId);
2815
2816	if (version >= 50) {
2817	// If object is an array section or element, the base expression must be
2818	// a language identifier.
2819	for (const parser::OmpObject &object : objects.v) {
2820	if (auto *elem{GetArrayElementFromObj(object)}) {
2821	const parser::DataRef &base = elem->base;
2822	if (!std::holds_alternative<parser::Name>(base.u)) {
2823	auto source{GetObjectSource(object)};
2824	context_.Say(source ? *source : GetContext().clauseSource,
2825	"The base expression of an array element or section in %s clause must be an identifier"_err_en_US,
2826	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
2827	}
2828	}
2829	}
2830	// Type parameter inquiries are not allowed.
2831	for (const parser::OmpObject &object : objects.v) {
2832	if (auto *dataRef{GetDataRefFromObj(object)}) {
2833	if (IsDataRefTypeParamInquiry(dataRef)) {
2834	auto source{GetObjectSource(object)};
2835	context_.Say(source ? *source : GetContext().clauseSource,
2836	"Type parameter inquiry is not permitted in %s clause"_err_en_US,
2837	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
2838	}
2839	}
2840	}
2841	}
2842	}
2843
2844	static bool CheckSymbolSupportsType(const Scope &scope,
2845	const parser::CharBlock &name, const DeclTypeSpec &type) {
2846	if (const auto *symbol{scope.FindSymbol(name)}) {
2847	if (const auto *reductionDetails{
2848	symbol->detailsIf<UserReductionDetails>()}) {
2849	return reductionDetails->SupportsType(type);
2850	}
2851	}
2852	return false;
2853	}
2854
2855	static bool IsReductionAllowedForType(
2856	const parser::OmpReductionIdentifier &ident, const DeclTypeSpec &type,
2857	const Scope &scope, SemanticsContext &context) {
2858	auto isLogical{[](const DeclTypeSpec &type) -> bool {
2859	return type.category() == DeclTypeSpec::Logical;
2860	}};
2861	auto isCharacter{[](const DeclTypeSpec &type) -> bool {
2862	return type.category() == DeclTypeSpec::Character;
2863	}};
2864
2865	auto checkOperator{[&](const parser::DefinedOperator &dOpr) {
2866	if (const auto *intrinsicOp{
2867	std::get_if<parser::DefinedOperator::IntrinsicOperator>(&dOpr.u)}) {
2868	// OMP5.2: The type [...] of a list item that appears in a
2869	// reduction clause must be valid for the combiner expression
2870	// See F2023: Table 10.2
2871	// .LT., .LE., .GT., .GE. are handled as procedure designators
2872	// below.
2873	switch (*intrinsicOp) {
2874	case parser::DefinedOperator::IntrinsicOperator::Multiply:
2875	case parser::DefinedOperator::IntrinsicOperator::Add:
2876	case parser::DefinedOperator::IntrinsicOperator::Subtract:
2877	if (type.IsNumeric(TypeCategory::Integer) ||
2878	type.IsNumeric(TypeCategory::Real) ||
2879	type.IsNumeric(TypeCategory::Complex))
2880	return true;
2881	break;
2882
2883	case parser::DefinedOperator::IntrinsicOperator::AND:
2884	case parser::DefinedOperator::IntrinsicOperator::OR:
2885	case parser::DefinedOperator::IntrinsicOperator::EQV:
2886	case parser::DefinedOperator::IntrinsicOperator::NEQV:
2887	if (isLogical(type)) {
2888	return true;
2889	}
2890	break;
2891
2892	// Reduction identifier is not in OMP5.2 Table 5.2
2893	default:
2894	DIE("This should have been caught in CheckIntrinsicOperator");
2895	return false;
2896	}
2897	parser::CharBlock name{MakeNameFromOperator(*intrinsicOp, context)};
2898	return CheckSymbolSupportsType(scope, name, type);
2899	} else if (const auto *definedOp{
2900	std::get_if<parser::DefinedOpName>(&dOpr.u)}) {
2901	return CheckSymbolSupportsType(
2902	scope, MangleDefinedOperator(definedOp->v.symbol->name()), type);
2903	}
2904	llvm_unreachable(
2905	"A DefinedOperator is either a DefinedOpName or an IntrinsicOperator");
2906	}};
2907
2908	auto checkDesignator{[&](const parser::ProcedureDesignator &procD) {
2909	const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
2910	CHECK(name && name->symbol);
2911	if (name && name->symbol) {
2912	const SourceName &realName{name->symbol->GetUltimate().name()};
2913	// OMP5.2: The type [...] of a list item that appears in a
2914	// reduction clause must be valid for the combiner expression
2915	if (realName == "iand" || realName == "ior" || realName == "ieor") {
2916	// IAND: arguments must be integers: F2023 16.9.100
2917	// IEOR: arguments must be integers: F2023 16.9.106
2918	// IOR: arguments must be integers: F2023 16.9.111
2919	if (type.IsNumeric(TypeCategory::Integer)) {
2920	return true;
2921	}
2922	} else if (realName == "max" || realName == "min") {
2923	// MAX: arguments must be integer, real, or character:
2924	// F2023 16.9.135
2925	// MIN: arguments must be integer, real, or character:
2926	// F2023 16.9.141
2927	if (type.IsNumeric(TypeCategory::Integer) ||
2928	type.IsNumeric(TypeCategory::Real) || isCharacter(type)) {
2929	return true;
2930	}
2931	}
2932
2933	// If we get here, it may be a user declared reduction, so check
2934	// if the symbol has UserReductionDetails, and if so, the type is
2935	// supported.
2936	if (const auto *reductionDetails{
2937	name->symbol->detailsIf<UserReductionDetails>()}) {
2938	return reductionDetails->SupportsType(type);
2939	}
2940
2941	// We also need to check for mangled names (max, min, iand, ieor and ior)
2942	// and then check if the type is there.
2943	parser::CharBlock mangledName{MangleSpecialFunctions(name->source)};
2944	return CheckSymbolSupportsType(scope, mangledName, type);
2945	}
2946	// Everything else is "not matching type".
2947	return false;
2948	}};
2949
2950	return common::visit(
2951	common::visitors{checkOperator, checkDesignator}, ident.u);
2952	}
2953
2954	void OmpStructureChecker::CheckReductionObjectTypes(
2955	const parser::OmpObjectList &objects,
2956	const parser::OmpReductionIdentifier &ident) {
2957	SymbolSourceMap symbols;
2958	GetSymbolsInObjectList(objects, symbols);
2959
2960	for (auto &[symbol, source] : symbols) {
2961	if (auto *type{symbol->GetType()}) {
2962	const auto &scope{context_.FindScope(symbol->name())};
2963	if (!IsReductionAllowedForType(ident, *type, scope, context_)) {
2964	context_.Say(source,
2965	"The type of '%s' is incompatible with the reduction operator."_err_en_US,
2966	symbol->name());
2967	}
2968	} else {
2969	assert(IsProcedurePointer(*symbol) && "Unexpected symbol properties");
2970	}
2971	}
2972	}
2973
2974	void OmpStructureChecker::CheckReductionModifier(
2975	const parser::OmpReductionModifier &modifier) {
2976	using ReductionModifier = parser::OmpReductionModifier;
2977	if (modifier.v == ReductionModifier::Value::Default) {
2978	// The default one is always ok.
2979	return;
2980	}
2981	const DirectiveContext &dirCtx{GetContext()};
2982	if (dirCtx.directive == llvm::omp::Directive::OMPD_loop ||
2983	dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {
2984	// [5.2:257:33-34]
2985	// If a reduction-modifier is specified in a reduction clause that
2986	// appears on the directive, then the reduction modifier must be
2987	// default.
2988	// [5.2:268:16]
2989	// The reduction-modifier must be default.
2990	context_.Say(GetContext().clauseSource,
2991	"REDUCTION modifier on %s directive must be DEFAULT"_err_en_US,
2992	parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
2993	return;
2994	}
2995	if (modifier.v == ReductionModifier::Value::Task) {
2996	// "Task" is only allowed on worksharing or "parallel" directive.
2997	static llvm::omp::Directive worksharing[]{
2998	llvm::omp::Directive::OMPD_do, llvm::omp::Directive::OMPD_scope,
2999	llvm::omp::Directive::OMPD_sections,
3000	// There are more worksharing directives, but they do not apply:
3001	// "for" is C++ only,
3002	// "single" and "workshare" don't allow reduction clause,
3003	// "loop" has different restrictions (checked above).
3004	};
3005	if (dirCtx.directive != llvm::omp::Directive::OMPD_parallel &&
3006	!llvm::is_contained(worksharing, dirCtx.directive)) {
3007	context_.Say(GetContext().clauseSource,
3008	"Modifier 'TASK' on REDUCTION clause is only allowed with "
3009	"PARALLEL or worksharing directive"_err_en_US);
3010	}
3011	} else if (modifier.v == ReductionModifier::Value::Inscan) {
3012	// "Inscan" is only allowed on worksharing-loop, worksharing-loop simd,
3013	// or "simd" directive.
3014	// The worksharing-loop directives are OMPD_do and OMPD_for. Only the
3015	// former is allowed in Fortran.
3016	if (!llvm::omp::scanParentAllowedSet.test(dirCtx.directive)) {
3017	context_.Say(GetContext().clauseSource,
3018	"Modifier 'INSCAN' on REDUCTION clause is only allowed with "
3019	"WORKSHARING LOOP, WORKSHARING LOOP SIMD, "
3020	"or SIMD directive"_err_en_US);
3021	}
3022	} else {
3023	// Catch-all for potential future modifiers to make sure that this
3024	// function is up-to-date.
3025	context_.Say(GetContext().clauseSource,
3026	"Unexpected modifier on REDUCTION clause"_err_en_US);
3027	}
3028	}
3029
3030	void OmpStructureChecker::CheckReductionArraySection(
3031	const parser::OmpObjectList &ompObjectList, llvm::omp::Clause clauseId) {
3032	for (const auto &ompObject : ompObjectList.v) {
3033	if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
3034	if (const auto *arrayElement{
3035	parser::Unwrap<parser::ArrayElement>(ompObject)}) {
3036	CheckArraySection(*arrayElement, GetLastName(*dataRef), clauseId);
3037	}
3038	}
3039	}
3040	}
3041
3042	void OmpStructureChecker::CheckSharedBindingInOuterContext(
3043	const parser::OmpObjectList &redObjectList) {
3044	// TODO: Verify the assumption here that the immediately enclosing region is
3045	// the parallel region to which the worksharing construct having reduction
3046	// binds to.
3047	if (auto *enclosingContext{GetEnclosingDirContext()}) {
3048	for (auto it : enclosingContext->clauseInfo) {
3049	llvmOmpClause type = it.first;
3050	const auto *clause = it.second;
3051	if (llvm::omp::privateReductionSet.test(type)) {
3052	if (const auto *objList{GetOmpObjectList(*clause)}) {
3053	for (const auto &ompObject : objList->v) {
3054	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3055	if (const auto *symbol{name->symbol}) {
3056	for (const auto &redOmpObject : redObjectList.v) {
3057	if (const auto *rname{
3058	parser::Unwrap<parser::Name>(redOmpObject)}) {
3059	if (const auto *rsymbol{rname->symbol}) {
3060	if (rsymbol->name() == symbol->name()) {
3061	context_.Say(GetContext().clauseSource,
3062	"%s variable '%s' is %s in outer context must"
3063	" be shared in the parallel regions to which any"
3064	" of the worksharing regions arising from the "
3065	"worksharing construct bind."_err_en_US,
3066	parser::ToUpperCaseLetters(
3067	getClauseName(llvm::omp::Clause::OMPC_reduction)
3068	.str()),
3069	symbol->name(),
3070	parser::ToUpperCaseLetters(
3071	getClauseName(type).str()));
3072	}
3073	}
3074	}
3075	}
3076	}
3077	}
3078	}
3079	}
3080	}
3081	}
3082	}
3083	}
3084
3085	void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
3086	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_ordered);
3087	// the parameter of ordered clause is optional
3088	if (const auto &expr{x.v}) {
3089	RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
3090	// 2.8.3 Loop SIMD Construct Restriction
3091	if (llvm::omp::allDoSimdSet.test(GetContext().directive)) {
3092	context_.Say(GetContext().clauseSource,
3093	"No ORDERED clause with a parameter can be specified "
3094	"on the %s directive"_err_en_US,
3095	ContextDirectiveAsFortran());
3096	}
3097	}
3098	}
3099
3100	void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) {
3101	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_shared);
3102	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "SHARED");
3103	CheckCrayPointee(x.v, "SHARED");
3104	}
3105	void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
3106	SymbolSourceMap symbols;
3107	GetSymbolsInObjectList(x.v, symbols);
3108	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_private);
3109	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "PRIVATE");
3110	CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_private);
3111	CheckCrayPointee(x.v, "PRIVATE");
3112	}
3113
3114	void OmpStructureChecker::Enter(const parser::OmpClause::Nowait &x) {
3115	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_nowait);
3116	}
3117
3118	bool OmpStructureChecker::IsDataRefTypeParamInquiry(
3119	const parser::DataRef *dataRef) {
3120	bool dataRefIsTypeParamInquiry{false};
3121	if (const auto *structComp{
3122	parser::Unwrap<parser::StructureComponent>(dataRef)}) {
3123	if (const auto *compSymbol{structComp->component.symbol}) {
3124	if (const auto *compSymbolMiscDetails{
3125	std::get_if<MiscDetails>(&compSymbol->details())}) {
3126	const auto detailsKind = compSymbolMiscDetails->kind();
3127	dataRefIsTypeParamInquiry =
3128	(detailsKind == MiscDetails::Kind::KindParamInquiry ||
3129	detailsKind == MiscDetails::Kind::LenParamInquiry);
3130	} else if (compSymbol->has<TypeParamDetails>()) {
3131	dataRefIsTypeParamInquiry = true;
3132	}
3133	}
3134	}
3135	return dataRefIsTypeParamInquiry;
3136	}
3137
3138	void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
3139	const parser::CharBlock &source, const parser::OmpObjectList &objList,
3140	llvm::StringRef clause) {
3141	for (const auto &ompObject : objList.v) {
3142	CheckVarIsNotPartOfAnotherVar(source, ompObject, clause);
3143	}
3144	}
3145
3146	void OmpStructureChecker::CheckVarIsNotPartOfAnotherVar(
3147	const parser::CharBlock &source, const parser::OmpObject &ompObject,
3148	llvm::StringRef clause) {
3149	common::visit(
3150	common::visitors{
3151	[&](const parser::Designator &designator) {
3152	if (const auto *dataRef{
3153	std::get_if<parser::DataRef>(&designator.u)}) {
3154	if (IsDataRefTypeParamInquiry(dataRef)) {
3155	context_.Say(source,
3156	"A type parameter inquiry cannot appear on the %s directive"_err_en_US,
3157	ContextDirectiveAsFortran());
3158	} else if (parser::Unwrap<parser::StructureComponent>(
3159	ompObject) ||
3160	parser::Unwrap<parser::ArrayElement>(ompObject)) {
3161	if (llvm::omp::nonPartialVarSet.test(GetContext().directive)) {
3162	context_.Say(source,
3163	"A variable that is part of another variable (as an array or structure element) cannot appear on the %s directive"_err_en_US,
3164	ContextDirectiveAsFortran());
3165	} else {
3166	context_.Say(source,
3167	"A variable that is part of another variable (as an array or structure element) cannot appear in a %s clause"_err_en_US,
3168	clause.data());
3169	}
3170	}
3171	}
3172	},
3173	[&](const parser::Name &name) {},
3174	},
3175	ompObject.u);
3176	}
3177
3178	void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
3179	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_firstprivate);
3180
3181	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v, "FIRSTPRIVATE");
3182	CheckCrayPointee(x.v, "FIRSTPRIVATE");
3183	CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
3184
3185	SymbolSourceMap currSymbols;
3186	GetSymbolsInObjectList(x.v, currSymbols);
3187	CheckCopyingPolymorphicAllocatable(
3188	currSymbols, llvm::omp::Clause::OMPC_firstprivate);
3189
3190	DirectivesClauseTriple dirClauseTriple;
3191	// Check firstprivate variables in worksharing constructs
3192	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
3193	std::make_pair(
3194	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3195	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
3196	std::make_pair(
3197	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3198	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_single,
3199	std::make_pair(
3200	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3201	// Check firstprivate variables in distribute construct
3202	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
3203	std::make_pair(
3204	llvm::omp::Directive::OMPD_teams, llvm::omp::privateReductionSet));
3205	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_distribute,
3206	std::make_pair(llvm::omp::Directive::OMPD_target_teams,
3207	llvm::omp::privateReductionSet));
3208	// Check firstprivate variables in task and taskloop constructs
3209	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_task,
3210	std::make_pair(llvm::omp::Directive::OMPD_parallel,
3211	OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
3212	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_taskloop,
3213	std::make_pair(llvm::omp::Directive::OMPD_parallel,
3214	OmpClauseSet{llvm::omp::Clause::OMPC_reduction}));
3215
3216	CheckPrivateSymbolsInOuterCxt(
3217	currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_firstprivate);
3218	}
3219
3220	void OmpStructureChecker::CheckIsLoopIvPartOfClause(
3221	llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
3222	for (const auto &ompObject : ompObjectList.v) {
3223	if (const parser::Name *name{parser::Unwrap<parser::Name>(ompObject)}) {
3224	if (name->symbol == GetContext().loopIV) {
3225	context_.Say(name->source,
3226	"DO iteration variable %s is not allowed in %s clause."_err_en_US,
3227	name->ToString(),
3228	parser::ToUpperCaseLetters(getClauseName(clause).str()));
3229	}
3230	}
3231	}
3232	}
3233
3234	// Restrictions specific to each clause are implemented apart from the
3235	// generalized restrictions.
3236	void OmpStructureChecker::Enter(const parser::OmpClause::Aligned &x) {
3237	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_aligned);
3238	if (OmpVerifyModifiers(
3239	x.v, llvm::omp::OMPC_aligned, GetContext().clauseSource, context_)) {
3240	auto &modifiers{OmpGetModifiers(x.v)};
3241	if (auto *align{OmpGetUniqueModifier<parser::OmpAlignment>(modifiers)}) {
3242	if (const auto &v{GetIntValue(align->v)}; !v || *v <= 0) {
3243	context_.Say(OmpGetModifierSource(modifiers, align),
3244	"The alignment value should be a constant positive integer"_err_en_US);
3245	}
3246	}
3247	}
3248	// 2.8.1 TODO: list-item attribute check
3249	}
3250
3251	void OmpStructureChecker::Enter(const parser::OmpClause::Defaultmap &x) {
3252	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_defaultmap);
3253	unsigned version{context_.langOptions().OpenMPVersion};
3254	using ImplicitBehavior = parser::OmpDefaultmapClause::ImplicitBehavior;
3255	auto behavior{std::get<ImplicitBehavior>(x.v.t)};
3256	if (version <= 45) {
3257	if (behavior != ImplicitBehavior::Tofrom) {
3258	context_.Say(GetContext().clauseSource,
3259	"%s is not allowed in %s, %s"_warn_en_US,
3260	parser::ToUpperCaseLetters(
3261	parser::OmpDefaultmapClause::EnumToString(behavior)),
3262	ThisVersion(version), TryVersion(50));
3263	}
3264	}
3265	if (!OmpVerifyModifiers(x.v, llvm::omp::OMPC_defaultmap,
3266	GetContext().clauseSource, context_)) {
3267	// If modifier verification fails, return early.
3268	return;
3269	}
3270	auto &modifiers{OmpGetModifiers(x.v)};
3271	auto *maybeCategory{
3272	OmpGetUniqueModifier<parser::OmpVariableCategory>(modifiers)};
3273	if (maybeCategory) {
3274	using VariableCategory = parser::OmpVariableCategory;
3275	VariableCategory::Value category{maybeCategory->v};
3276	unsigned tryVersion{0};
3277	if (version <= 45 && category != VariableCategory::Value::Scalar) {
3278	tryVersion = 50;
3279	}
3280	if (version < 52 && category == VariableCategory::Value::All) {
3281	tryVersion = 52;
3282	}
3283	if (tryVersion) {
3284	context_.Say(GetContext().clauseSource,
3285	"%s is not allowed in %s, %s"_warn_en_US,
3286	parser::ToUpperCaseLetters(VariableCategory::EnumToString(category)),
3287	ThisVersion(version), TryVersion(tryVersion));
3288	}
3289	}
3290	}
3291
3292	void OmpStructureChecker::Enter(const parser::OmpClause::If &x) {
3293	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_if);
3294	unsigned version{context_.langOptions().OpenMPVersion};
3295	llvm::omp::Directive dir{GetContext().directive};
3296
3297	auto isConstituent{[](llvm::omp::Directive dir, llvm::omp::Directive part) {
3298	using namespace llvm::omp;
3299	llvm::ArrayRef<Directive> dirLeafs{getLeafConstructsOrSelf(D: dir)};
3300	llvm::ArrayRef<Directive> partLeafs{getLeafConstructsOrSelf(D: part)};
3301	// Maybe it's sufficient to check if every leaf of `part` is also a leaf
3302	// of `dir`, but to be safe check if `partLeafs` is a sub-sequence of
3303	// `dirLeafs`.
3304	size_t dirSize{dirLeafs.size()}, partSize{partLeafs.size()};
3305	// Find the first leaf from `part` in `dir`.
3306	if (auto first = llvm::find(Range&: dirLeafs, Val: partLeafs.front());
3307	first != dirLeafs.end()) {
3308	// A leaf can only appear once in a compound directive, so if `part`
3309	// is a subsequence of `dir`, it must start here.
3310	size_t firstPos{
3311	static_cast<size_t>(std::distance(first: dirLeafs.begin(), last: first))};
3312	llvm::ArrayRef<Directive> subSeq{
3313	first, std::min<size_t>(a: dirSize - firstPos, b: partSize)};
3314	return subSeq == partLeafs;
3315	}
3316	return false;
3317	}};
3318
3319	if (OmpVerifyModifiers(
3320	x.v, llvm::omp::OMPC_if, GetContext().clauseSource, context_)) {
3321	auto &modifiers{OmpGetModifiers(x.v)};
3322	if (auto *dnm{OmpGetUniqueModifier<parser::OmpDirectiveNameModifier>(
3323	modifiers)}) {
3324	llvm::omp::Directive sub{dnm->v};
3325	std::string subName{
3326	parser::ToUpperCaseLetters(getDirectiveName(sub).str())};
3327	std::string dirName{
3328	parser::ToUpperCaseLetters(getDirectiveName(dir).str())};
3329
3330	parser::CharBlock modifierSource{OmpGetModifierSource(modifiers, dnm)};
3331	auto desc{OmpGetDescriptor<parser::OmpDirectiveNameModifier>()};
3332	std::string modName{desc.name.str()};
3333
3334	if (!isConstituent(dir, sub)) {
3335	context_
3336	.Say(modifierSource,
3337	"%s is not a constituent of the %s directive"_err_en_US,
3338	subName, dirName)
3339	.Attach(GetContext().directiveSource,
3340	"Cannot apply to directive"_en_US);
3341	} else {
3342	static llvm::omp::Directive valid45[]{
3343	llvm::omp::OMPD_cancel, //
3344	llvm::omp::OMPD_parallel, //
3345	/* OMP 5.0+ also allows OMPD_simd */
3346	llvm::omp::OMPD_target, //
3347	llvm::omp::OMPD_target_data, //
3348	llvm::omp::OMPD_target_enter_data, //
3349	llvm::omp::OMPD_target_exit_data, //
3350	llvm::omp::OMPD_target_update, //
3351	llvm::omp::OMPD_task, //
3352	llvm::omp::OMPD_taskloop, //
3353	/* OMP 5.2+ also allows OMPD_teams */
3354	};
3355	if (version < 50 && sub == llvm::omp::OMPD_simd) {
3356	context_.Say(modifierSource,
3357	"%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,
3358	modName, ThisVersion(version), TryVersion(50));
3359	} else if (version < 52 && sub == llvm::omp::OMPD_teams) {
3360	context_.Say(modifierSource,
3361	"%s is not allowed as '%s' in %s, %s"_warn_en_US, subName,
3362	modName, ThisVersion(version), TryVersion(52));
3363	} else if (!llvm::is_contained(Range&: valid45, Element: sub) &&
3364	sub != llvm::omp::OMPD_simd && sub != llvm::omp::OMPD_teams) {
3365	context_.Say(modifierSource,
3366	"%s is not allowed as '%s' in %s"_err_en_US, subName, modName,
3367	ThisVersion(version));
3368	}
3369	}
3370	}
3371	}
3372	}
3373
3374	void OmpStructureChecker::Enter(const parser::OmpClause::Detach &x) {
3375	unsigned version{context_.langOptions().OpenMPVersion};
3376	if (version >= 52) {
3377	SetContextClauseInfo(llvm::omp::Clause::OMPC_detach);
3378	} else {
3379	// OpenMP 5.0: 2.10.1 Task construct restrictions
3380	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_detach);
3381	}
3382	// OpenMP 5.2: 12.5.2 Detach clause restrictions
3383	if (version >= 52) {
3384	CheckVarIsNotPartOfAnotherVar(GetContext().clauseSource, x.v.v, "DETACH");
3385	}
3386
3387	if (const auto *name{parser::Unwrap<parser::Name>(x.v.v)}) {
3388	if (version >= 52 && IsPointer(*name->symbol)) {
3389	context_.Say(GetContext().clauseSource,
3390	"The event-handle: `%s` must not have the POINTER attribute"_err_en_US,
3391	name->ToString());
3392	}
3393	if (!name->symbol->GetType()->IsNumeric(TypeCategory::Integer)) {
3394	context_.Say(GetContext().clauseSource,
3395	"The event-handle: `%s` must be of type integer(kind=omp_event_handle_kind)"_err_en_US,
3396	name->ToString());
3397	}
3398	}
3399	}
3400
3401	void OmpStructureChecker::CheckAllowedMapTypes(
3402	const parser::OmpMapType::Value &type,
3403	const std::list<parser::OmpMapType::Value> &allowedMapTypeList) {
3404	if (!llvm::is_contained(allowedMapTypeList, type)) {
3405	std::string commaSeparatedMapTypes;
3406	llvm::interleave(
3407	allowedMapTypeList.begin(), allowedMapTypeList.end(),
3408	[&](const parser::OmpMapType::Value &mapType) {
3409	commaSeparatedMapTypes.append(parser::ToUpperCaseLetters(
3410	parser::OmpMapType::EnumToString(mapType)));
3411	},
3412	[&] { commaSeparatedMapTypes.append(s: ", "); });
3413	context_.Say(GetContext().clauseSource,
3414	"Only the %s map types are permitted "
3415	"for MAP clauses on the %s directive"_err_en_US,
3416	commaSeparatedMapTypes, ContextDirectiveAsFortran());
3417	}
3418	}
3419
3420	void OmpStructureChecker::Enter(const parser::OmpClause::Map &x) {
3421	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_map);
3422	if (!OmpVerifyModifiers(
3423	x.v, llvm::omp::OMPC_map, GetContext().clauseSource, context_)) {
3424	return;
3425	}
3426
3427	auto &modifiers{OmpGetModifiers(x.v)};
3428	unsigned version{context_.langOptions().OpenMPVersion};
3429	if (auto commas{std::get<bool>(x.v.t)}; !commas && version >= 52) {
3430	context_.Say(GetContext().clauseSource,
3431	"The specification of modifiers without comma separators for the "
3432	"'MAP' clause has been deprecated in OpenMP 5.2"_port_en_US);
3433	}
3434	if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
3435	CheckIteratorModifier(*iter);
3436	}
3437	if (auto *type{OmpGetUniqueModifier<parser::OmpMapType>(modifiers)}) {
3438	using Value = parser::OmpMapType::Value;
3439	switch (GetContext().directive) {
3440	case llvm::omp::Directive::OMPD_target:
3441	case llvm::omp::Directive::OMPD_target_teams:
3442	case llvm::omp::Directive::OMPD_target_teams_distribute:
3443	case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
3444	case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
3445	case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
3446	case llvm::omp::Directive::OMPD_target_data:
3447	CheckAllowedMapTypes(
3448	type->v, {Value::To, Value::From, Value::Tofrom, Value::Alloc});
3449	break;
3450	case llvm::omp::Directive::OMPD_target_enter_data:
3451	CheckAllowedMapTypes(type->v, {Value::To, Value::Alloc});
3452	break;
3453	case llvm::omp::Directive::OMPD_target_exit_data:
3454	CheckAllowedMapTypes(
3455	type->v, {Value::From, Value::Release, Value::Delete});
3456	break;
3457	default:
3458	break;
3459	}
3460	}
3461
3462	auto &&typeMods{
3463	OmpGetRepeatableModifier<parser::OmpMapTypeModifier>(modifiers)};
3464	struct Less {
3465	using Iterator = decltype(typeMods.begin());
3466	bool operator()(Iterator a, Iterator b) const {
3467	const parser::OmpMapTypeModifier *pa = *a;
3468	const parser::OmpMapTypeModifier *pb = *b;
3469	return pa->v < pb->v;
3470	}
3471	};
3472	if (auto maybeIter{FindDuplicate<Less>(typeMods)}) {
3473	context_.Say(GetContext().clauseSource,
3474	"Duplicate map-type-modifier entry '%s' will be ignored"_warn_en_US,
3475	parser::ToUpperCaseLetters(
3476	parser::OmpMapTypeModifier::EnumToString((**maybeIter)->v)));
3477	}
3478	}
3479
3480	void OmpStructureChecker::Enter(const parser::OmpClause::Schedule &x) {
3481	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_schedule);
3482	const parser::OmpScheduleClause &scheduleClause = x.v;
3483	if (!OmpVerifyModifiers(scheduleClause, llvm::omp::OMPC_schedule,
3484	GetContext().clauseSource, context_)) {
3485	return;
3486	}
3487
3488	// 2.7 Loop Construct Restriction
3489	if (llvm::omp::allDoSet.test(GetContext().directive)) {
3490	auto &modifiers{OmpGetModifiers(scheduleClause)};
3491	auto kind{std::get<parser::OmpScheduleClause::Kind>(scheduleClause.t)};
3492	auto &chunk{
3493	std::get<std::optional<parser::ScalarIntExpr>>(scheduleClause.t)};
3494	if (chunk) {
3495	if (kind == parser::OmpScheduleClause::Kind::Runtime ||
3496	kind == parser::OmpScheduleClause::Kind::Auto) {
3497	context_.Say(GetContext().clauseSource,
3498	"When SCHEDULE clause has %s specified, "
3499	"it must not have chunk size specified"_err_en_US,
3500	parser::ToUpperCaseLetters(
3501	parser::OmpScheduleClause::EnumToString(kind)));
3502	}
3503	if (const auto &chunkExpr{std::get<std::optional<parser::ScalarIntExpr>>(
3504	scheduleClause.t)}) {
3505	RequiresPositiveParameter(
3506	llvm::omp::Clause::OMPC_schedule, *chunkExpr, "chunk size");
3507	}
3508	}
3509
3510	auto *ordering{
3511	OmpGetUniqueModifier<parser::OmpOrderingModifier>(modifiers)};
3512	if (ordering &&
3513	ordering->v == parser::OmpOrderingModifier::Value::Nonmonotonic) {
3514	if (kind != parser::OmpScheduleClause::Kind::Dynamic &&
3515	kind != parser::OmpScheduleClause::Kind::Guided) {
3516	context_.Say(GetContext().clauseSource,
3517	"The NONMONOTONIC modifier can only be specified with "
3518	"SCHEDULE(DYNAMIC) or SCHEDULE(GUIDED)"_err_en_US);
3519	}
3520	}
3521	}
3522	}
3523
3524	void OmpStructureChecker::Enter(const parser::OmpClause::Device &x) {
3525	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_device);
3526	const parser::OmpDeviceClause &deviceClause{x.v};
3527	const auto &device{std::get<parser::ScalarIntExpr>(deviceClause.t)};
3528	RequiresPositiveParameter(
3529	llvm::omp::Clause::OMPC_device, device, "device expression");
3530	llvm::omp::Directive dir{GetContext().directive};
3531
3532	if (OmpVerifyModifiers(deviceClause, llvm::omp::OMPC_device,
3533	GetContext().clauseSource, context_)) {
3534	auto &modifiers{OmpGetModifiers(deviceClause)};
3535
3536	if (auto *deviceMod{
3537	OmpGetUniqueModifier<parser::OmpDeviceModifier>(modifiers)}) {
3538	using Value = parser::OmpDeviceModifier::Value;
3539	if (dir != llvm::omp::OMPD_target && deviceMod->v == Value::Ancestor) {
3540	auto name{OmpGetDescriptor<parser::OmpDeviceModifier>().name};
3541	context_.Say(OmpGetModifierSource(modifiers, deviceMod),
3542	"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,
3543	name.str(), parser::ToUpperCaseLetters(getDirectiveName(dir)));
3544	}
3545	}
3546	}
3547	}
3548
3549	void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
3550	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_depend);
3551	llvm::omp::Directive dir{GetContext().directive};
3552	unsigned version{context_.langOptions().OpenMPVersion};
3553
3554	auto *doaDep{std::get_if<parser::OmpDoacross>(&x.v.u)};
3555	auto *taskDep{std::get_if<parser::OmpDependClause::TaskDep>(&x.v.u)};
3556	assert(((doaDep == nullptr) != (taskDep == nullptr)) &&
3557	"Unexpected alternative in update clause");
3558
3559	if (doaDep) {
3560	CheckDoacross(*doaDep);
3561	CheckDependenceType(doaDep->GetDepType());
3562	} else {
3563	using Modifier = parser::OmpDependClause::TaskDep::Modifier;
3564	auto &modifiers{std::get<std::optional<std::list<Modifier>>>(taskDep->t)};
3565	if (!modifiers) {
3566	context_.Say(GetContext().clauseSource,
3567	"A DEPEND clause on a TASK construct must have a valid task dependence type"_err_en_US);
3568	return;
3569	}
3570	CheckTaskDependenceType(taskDep->GetTaskDepType());
3571	}
3572
3573	if (dir == llvm::omp::OMPD_depobj) {
3574	// [5.0:255:11], [5.1:288:3]
3575	// A depend clause on a depobj construct must not have source, sink [or
3576	// depobj](5.0) as dependence-type.
3577	if (version >= 50) {
3578	bool invalidDep{false};
3579	if (taskDep) {
3580	if (version == 50) {
3581	invalidDep = taskDep->GetTaskDepType() ==
3582	parser::OmpTaskDependenceType::Value::Depobj;
3583	}
3584	} else {
3585	invalidDep = true;
3586	}
3587	if (invalidDep) {
3588	context_.Say(GetContext().clauseSource,
3589	"A DEPEND clause on a DEPOBJ construct must not have %s as dependence type"_err_en_US,
3590	version == 50 ? "SINK, SOURCE or DEPOBJ" : "SINK or SOURCE");
3591	}
3592	}
3593	} else if (dir != llvm::omp::OMPD_ordered) {
3594	if (doaDep) {
3595	context_.Say(GetContext().clauseSource,
3596	"The SINK and SOURCE dependence types can only be used with the ORDERED directive, used here in the %s construct"_err_en_US,
3597	parser::ToUpperCaseLetters(getDirectiveName(dir)));
3598	}
3599	}
3600	if (taskDep) {
3601	auto &objList{std::get<parser::OmpObjectList>(taskDep->t)};
3602	if (dir == llvm::omp::OMPD_depobj) {
3603	// [5.0:255:13], [5.1:288:6], [5.2:322:26]
3604	// A depend clause on a depobj construct must only specify one locator.
3605	if (objList.v.size() != 1) {
3606	context_.Say(GetContext().clauseSource,
3607	"A DEPEND clause on a DEPOBJ construct must only specify "
3608	"one locator"_err_en_US);
3609	}
3610	}
3611	for (const auto &object : objList.v) {
3612	if (const auto *name{std::get_if<parser::Name>(&object.u)}) {
3613	context_.Say(GetContext().clauseSource,
3614	"Common block name ('%s') cannot appear in a DEPEND "
3615	"clause"_err_en_US,
3616	name->ToString());
3617	} else if (auto *designator{std::get_if<parser::Designator>(&object.u)}) {
3618	if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
3619	CheckDependList(*dataRef);
3620	if (const auto *arr{
3621	std::get_if<common::Indirection<parser::ArrayElement>>(
3622	&dataRef->u)}) {
3623	CheckArraySection(arr->value(), GetLastName(*dataRef),
3624	llvm::omp::Clause::OMPC_depend);
3625	}
3626	}
3627	}
3628	}
3629	if (OmpVerifyModifiers(*taskDep, llvm::omp::OMPC_depend,
3630	GetContext().clauseSource, context_)) {
3631	auto &modifiers{OmpGetModifiers(*taskDep)};
3632	if (OmpGetUniqueModifier<parser::OmpIterator>(modifiers)) {
3633	if (dir == llvm::omp::OMPD_depobj) {
3634	context_.Say(GetContext().clauseSource,
3635	"An iterator-modifier may specify multiple locators, a DEPEND clause on a DEPOBJ construct must only specify one locator"_warn_en_US);
3636	}
3637	}
3638	}
3639	}
3640	}
3641
3642	void OmpStructureChecker::Enter(const parser::OmpClause::Doacross &x) {
3643	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_doacross);
3644	CheckDoacross(x.v.v);
3645	}
3646
3647	void OmpStructureChecker::CheckDoacross(const parser::OmpDoacross &doa) {
3648	if (std::holds_alternative<parser::OmpDoacross::Source>(doa.u)) {
3649	// Nothing to check here.
3650	return;
3651	}
3652
3653	// Process SINK dependence type. SINK may only appear in an ORDER construct,
3654	// which references a prior ORDERED(n) clause on a DO or SIMD construct
3655	// that marks the top of the loop nest.
3656
3657	auto &sink{std::get<parser::OmpDoacross::Sink>(doa.u)};
3658	const std::list<parser::OmpIteration> &vec{sink.v.v};
3659
3660	// Check if the variables in the iteration vector are unique.
3661	struct Less {
3662	using Iterator = std::list<parser::OmpIteration>::const_iterator;
3663	bool operator()(Iterator a, Iterator b) const {
3664	auto namea{std::get<parser::Name>(a->t)};
3665	auto nameb{std::get<parser::Name>(b->t)};
3666	assert(namea.symbol && nameb.symbol && "Unresolved symbols");
3667	// The non-determinism of the "<" doesn't matter, we only care about
3668	// equality, i.e. a == b <=> !(a < b) && !(b < a)
3669	return reinterpret_cast<uintptr_t>(namea.symbol) <
3670	reinterpret_cast<uintptr_t>(nameb.symbol);
3671	}
3672	};
3673	if (auto maybeIter{FindDuplicate<Less>(vec)}) {
3674	auto name{std::get<parser::Name>((*maybeIter)->t)};
3675	context_.Say(name.source,
3676	"Duplicate variable '%s' in the iteration vector"_err_en_US,
3677	name.ToString());
3678	}
3679
3680	// Check if the variables in the iteration vector are induction variables.
3681	// Ignore any mismatch between the size of the iteration vector and the
3682	// number of DO constructs on the stack. This is checked elsewhere.
3683
3684	auto GetLoopDirective{[](const parser::OpenMPLoopConstruct &x) {
3685	auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
3686	return std::get<parser::OmpLoopDirective>(begin.t).v;
3687	}};
3688	auto GetLoopClauses{[](const parser::OpenMPLoopConstruct &x)
3689	-> const std::list<parser::OmpClause> & {
3690	auto &begin{std::get<parser::OmpBeginLoopDirective>(x.t)};
3691	return std::get<parser::OmpClauseList>(begin.t).v;
3692	}};
3693
3694	std::set<const Symbol *> inductionVars;
3695	for (const LoopConstruct &loop : llvm::reverse(loopStack_)) {
3696	if (auto *doc{std::get_if<const parser::DoConstruct *>(&loop)}) {
3697	// Do-construct, collect the induction variable.
3698	if (auto &control{(*doc)->GetLoopControl()}) {
3699	if (auto *b{std::get_if<parser::LoopControl::Bounds>(&control->u)}) {
3700	inductionVars.insert(b->name.thing.symbol);
3701	}
3702	}
3703	} else {
3704	// Omp-loop-construct, check if it's do/simd with an ORDERED clause.
3705	auto *loopc{std::get_if<const parser::OpenMPLoopConstruct *>(&loop)};
3706	assert(loopc && "Expecting OpenMPLoopConstruct");
3707	llvm::omp::Directive loopDir{GetLoopDirective(**loopc)};
3708	if (loopDir == llvm::omp::OMPD_do || loopDir == llvm::omp::OMPD_simd) {
3709	auto IsOrdered{[](const parser::OmpClause &c) {
3710	return c.Id() == llvm::omp::OMPC_ordered;
3711	}};
3712	// If it has ORDERED clause, stop the traversal.
3713	if (llvm::any_of(GetLoopClauses(**loopc), IsOrdered)) {
3714	break;
3715	}
3716	}
3717	}
3718	}
3719	for (const parser::OmpIteration &iter : vec) {
3720	auto &name{std::get<parser::Name>(iter.t)};
3721	if (!inductionVars.count(name.symbol)) {
3722	context_.Say(name.source,
3723	"The iteration vector element '%s' is not an induction variable within the ORDERED loop nest"_err_en_US,
3724	name.ToString());
3725	}
3726	}
3727	}
3728
3729	void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
3730	SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
3731	if (context_.ShouldWarn(common::UsageWarning::Portability)) {
3732	for (auto &[symbol, source] : symbols) {
3733	if (IsPolymorphicAllocatable(*symbol)) {
3734	context_.Warn(common::UsageWarning::Portability, source,
3735	"If a polymorphic variable with allocatable attribute '%s' is in %s clause, the behavior is unspecified"_port_en_US,
3736	symbol->name(),
3737	parser::ToUpperCaseLetters(getClauseName(clause).str()));
3738	}
3739	}
3740	}
3741	}
3742
3743	void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
3744	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_copyprivate);
3745	SymbolSourceMap symbols;
3746	GetSymbolsInObjectList(x.v, symbols);
3747	CheckVariableListItem(symbols);
3748	CheckIntentInPointer(symbols, llvm::omp::Clause::OMPC_copyprivate);
3749	CheckCopyingPolymorphicAllocatable(
3750	symbols, llvm::omp::Clause::OMPC_copyprivate);
3751	}
3752
3753	void OmpStructureChecker::Enter(const parser::OmpClause::Lastprivate &x) {
3754	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_lastprivate);
3755
3756	const auto &objectList{std::get<parser::OmpObjectList>(x.v.t)};
3757	CheckVarIsNotPartOfAnotherVar(
3758	GetContext().clauseSource, objectList, "LASTPRIVATE");
3759	CheckCrayPointee(objectList, "LASTPRIVATE");
3760
3761	DirectivesClauseTriple dirClauseTriple;
3762	SymbolSourceMap currSymbols;
3763	GetSymbolsInObjectList(objectList, currSymbols);
3764	CheckDefinableObjects(currSymbols, llvm::omp::Clause::OMPC_lastprivate);
3765	CheckCopyingPolymorphicAllocatable(
3766	currSymbols, llvm::omp::Clause::OMPC_lastprivate);
3767
3768	// Check lastprivate variables in worksharing constructs
3769	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_do,
3770	std::make_pair(
3771	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3772	dirClauseTriple.emplace(llvm::omp::Directive::OMPD_sections,
3773	std::make_pair(
3774	llvm::omp::Directive::OMPD_parallel, llvm::omp::privateReductionSet));
3775
3776	CheckPrivateSymbolsInOuterCxt(
3777	currSymbols, dirClauseTriple, llvm::omp::Clause::OMPC_lastprivate);
3778
3779	if (OmpVerifyModifiers(x.v, llvm::omp::OMPC_lastprivate,
3780	GetContext().clauseSource, context_)) {
3781	auto &modifiers{OmpGetModifiers(x.v)};
3782	using LastprivateModifier = parser::OmpLastprivateModifier;
3783	if (auto *modifier{OmpGetUniqueModifier<LastprivateModifier>(modifiers)}) {
3784	CheckLastprivateModifier(*modifier);
3785	}
3786	}
3787	}
3788
3789	// Add any restrictions related to Modifiers/Directives with
3790	// Lastprivate clause here:
3791	void OmpStructureChecker::CheckLastprivateModifier(
3792	const parser::OmpLastprivateModifier &modifier) {
3793	using LastprivateModifier = parser::OmpLastprivateModifier;
3794	const DirectiveContext &dirCtx{GetContext()};
3795	if (modifier.v == LastprivateModifier::Value::Conditional &&
3796	dirCtx.directive == llvm::omp::Directive::OMPD_taskloop) {
3797	// [5.2:268:17]
3798	// The conditional lastprivate-modifier must not be specified.
3799	context_.Say(GetContext().clauseSource,
3800	"'CONDITIONAL' modifier on lastprivate clause with TASKLOOP "
3801	"directive is not allowed"_err_en_US);
3802	}
3803	}
3804
3805	void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
3806	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_copyin);
3807
3808	SymbolSourceMap currSymbols;
3809	GetSymbolsInObjectList(x.v, currSymbols);
3810	CheckCopyingPolymorphicAllocatable(
3811	currSymbols, llvm::omp::Clause::OMPC_copyin);
3812	}
3813
3814	void OmpStructureChecker::CheckStructureComponent(
3815	const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
3816	auto CheckComponent{[&](const parser::Designator &designator) {
3817	if (auto *dataRef{std::get_if<parser::DataRef>(&designator.u)}) {
3818	if (!IsDataRefTypeParamInquiry(dataRef)) {
3819	if (auto *comp{parser::Unwrap<parser::StructureComponent>(*dataRef)}) {
3820	context_.Say(comp->component.source,
3821	"A variable that is part of another variable cannot appear on the %s clause"_err_en_US,
3822	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
3823	}
3824	}
3825	}
3826	}};
3827
3828	for (const auto &object : objects.v) {
3829	common::visit(
3830	common::visitors{
3831	CheckComponent,
3832	[&](const parser::Name &name) {},
3833	},
3834	object.u);
3835	}
3836	}
3837
3838	void OmpStructureChecker::Enter(const parser::OmpClause::Update &x) {
3839	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_update);
3840	llvm::omp::Directive dir{GetContext().directive};
3841	unsigned version{context_.langOptions().OpenMPVersion};
3842
3843	const parser::OmpDependenceType *depType{nullptr};
3844	const parser::OmpTaskDependenceType *taskType{nullptr};
3845	if (auto &maybeUpdate{x.v}) {
3846	depType = std::get_if<parser::OmpDependenceType>(&maybeUpdate->u);
3847	taskType = std::get_if<parser::OmpTaskDependenceType>(&maybeUpdate->u);
3848	}
3849
3850	if (!depType && !taskType) {
3851	assert(dir == llvm::omp::Directive::OMPD_atomic &&
3852	"Unexpected alternative in update clause");
3853	return;
3854	}
3855
3856	if (depType) {
3857	CheckDependenceType(depType->v);
3858	} else if (taskType) {
3859	CheckTaskDependenceType(taskType->v);
3860	}
3861
3862	// [5.1:288:4-5]
3863	// An update clause on a depobj construct must not have source, sink or depobj
3864	// as dependence-type.
3865	// [5.2:322:3]
3866	// task-dependence-type must not be depobj.
3867	if (dir == llvm::omp::OMPD_depobj) {
3868	if (version >= 51) {
3869	bool invalidDep{false};
3870	if (taskType) {
3871	invalidDep =
3872	taskType->v == parser::OmpTaskDependenceType::Value::Depobj;
3873	} else {
3874	invalidDep = true;
3875	}
3876	if (invalidDep) {
3877	context_.Say(GetContext().clauseSource,
3878	"An UPDATE clause on a DEPOBJ construct must not have SINK, SOURCE or DEPOBJ as dependence type"_err_en_US);
3879	}
3880	}
3881	}
3882	}
3883
3884	void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
3885	CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_ptr);
3886	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_use_device_ptr);
3887	SymbolSourceMap currSymbols;
3888	GetSymbolsInObjectList(x.v, currSymbols);
3889	semantics::UnorderedSymbolSet listVars;
3890	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_use_device_ptr)) {
3891	const auto &useDevicePtrClause{
3892	std::get<parser::OmpClause::UseDevicePtr>(clause->u)};
3893	const auto &useDevicePtrList{useDevicePtrClause.v};
3894	std::list<parser::Name> useDevicePtrNameList;
3895	for (const auto &ompObject : useDevicePtrList.v) {
3896	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3897	if (name->symbol) {
3898	if (!(IsBuiltinCPtr(*(name->symbol)))) {
3899	context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
3900	"Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
3901	name->ToString());
3902	} else {
3903	useDevicePtrNameList.push_back(*name);
3904	}
3905	}
3906	}
3907	}
3908	CheckMultipleOccurrence(
3909	listVars, useDevicePtrNameList, clause->source, "USE_DEVICE_PTR");
3910	}
3911	}
3912
3913	void OmpStructureChecker::Enter(const parser::OmpClause::UseDeviceAddr &x) {
3914	CheckStructureComponent(x.v, llvm::omp::Clause::OMPC_use_device_addr);
3915	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_use_device_addr);
3916	SymbolSourceMap currSymbols;
3917	GetSymbolsInObjectList(x.v, currSymbols);
3918	semantics::UnorderedSymbolSet listVars;
3919	for (auto [_, clause] :
3920	FindClauses(llvm::omp::Clause::OMPC_use_device_addr)) {
3921	const auto &useDeviceAddrClause{
3922	std::get<parser::OmpClause::UseDeviceAddr>(clause->u)};
3923	const auto &useDeviceAddrList{useDeviceAddrClause.v};
3924	std::list<parser::Name> useDeviceAddrNameList;
3925	for (const auto &ompObject : useDeviceAddrList.v) {
3926	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3927	if (name->symbol) {
3928	useDeviceAddrNameList.push_back(*name);
3929	}
3930	}
3931	}
3932	CheckMultipleOccurrence(
3933	listVars, useDeviceAddrNameList, clause->source, "USE_DEVICE_ADDR");
3934	}
3935	}
3936
3937	void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
3938	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_is_device_ptr);
3939	SymbolSourceMap currSymbols;
3940	GetSymbolsInObjectList(x.v, currSymbols);
3941	semantics::UnorderedSymbolSet listVars;
3942	for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_is_device_ptr)) {
3943	const auto &isDevicePtrClause{
3944	std::get<parser::OmpClause::IsDevicePtr>(clause->u)};
3945	const auto &isDevicePtrList{isDevicePtrClause.v};
3946	SymbolSourceMap currSymbols;
3947	GetSymbolsInObjectList(isDevicePtrList, currSymbols);
3948	for (auto &[symbol, source] : currSymbols) {
3949	if (!(IsBuiltinCPtr(*symbol))) {
3950	context_.Say(clause->source,
3951	"Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
3952	source.ToString());
3953	} else if (!(IsDummy(*symbol))) {
3954	context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
3955	"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
3956	"This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
3957	source.ToString());
3958	} else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
3959	context_.Warn(common::UsageWarning::OpenMPUsage, clause->source,
3960	"Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
3961	"that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
3962	"This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
3963	source.ToString());
3964	}
3965	}
3966	}
3967	}
3968
3969	void OmpStructureChecker::Enter(const parser::OmpClause::HasDeviceAddr &x) {
3970	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_has_device_addr);
3971	SymbolSourceMap currSymbols;
3972	GetSymbolsInObjectList(x.v, currSymbols);
3973	semantics::UnorderedSymbolSet listVars;
3974	for (auto [_, clause] :
3975	FindClauses(llvm::omp::Clause::OMPC_has_device_addr)) {
3976	const auto &hasDeviceAddrClause{
3977	std::get<parser::OmpClause::HasDeviceAddr>(clause->u)};
3978	const auto &hasDeviceAddrList{hasDeviceAddrClause.v};
3979	std::list<parser::Name> hasDeviceAddrNameList;
3980	for (const auto &ompObject : hasDeviceAddrList.v) {
3981	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
3982	if (name->symbol) {
3983	hasDeviceAddrNameList.push_back(*name);
3984	}
3985	}
3986	}
3987	}
3988	}
3989
3990	void OmpStructureChecker::Enter(const parser::OmpClause::Enter &x) {
3991	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_enter);
3992	const parser::OmpObjectList &objList{x.v};
3993	SymbolSourceMap symbols;
3994	GetSymbolsInObjectList(objList, symbols);
3995	for (const auto &[symbol, source] : symbols) {
3996	if (!IsExtendedListItem(*symbol)) {
3997	context_.SayWithDecl(*symbol, source,
3998	"'%s' must be a variable or a procedure"_err_en_US, symbol->name());
3999	}
4000	}
4001	}
4002
4003	void OmpStructureChecker::Enter(const parser::OmpClause::From &x) {
4004	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_from);
4005	if (!OmpVerifyModifiers(
4006	x.v, llvm::omp::OMPC_from, GetContext().clauseSource, context_)) {
4007	return;
4008	}
4009
4010	auto &modifiers{OmpGetModifiers(x.v)};
4011	unsigned version{context_.langOptions().OpenMPVersion};
4012
4013	if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
4014	CheckIteratorModifier(*iter);
4015	}
4016
4017	const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
4018	SymbolSourceMap symbols;
4019	GetSymbolsInObjectList(objList, symbols);
4020	CheckVariableListItem(symbols);
4021
4022	// Ref: [4.5:109:19]
4023	// If a list item is an array section it must specify contiguous storage.
4024	if (version <= 45) {
4025	for (const parser::OmpObject &object : objList.v) {
4026	CheckIfContiguous(object);
4027	}
4028	}
4029	}
4030
4031	void OmpStructureChecker::Enter(const parser::OmpClause::To &x) {
4032	CheckAllowedClause(clause: llvm::omp::Clause::OMPC_to);
4033	if (!OmpVerifyModifiers(
4034	x.v, llvm::omp::OMPC_to, GetContext().clauseSource, context_)) {
4035	return;
4036	}
4037
4038	auto &modifiers{OmpGetModifiers(x.v)};
4039	unsigned version{context_.langOptions().OpenMPVersion};
4040
4041	// The "to" clause is only allowed on "declare target" (pre-5.1), and
4042	// "target update". In the former case it can take an extended list item,
4043	// in the latter a variable (a locator).
4044
4045	// The "declare target" construct (and the "to" clause on it) are already
4046	// handled (in the declare-target checkers), so just look at "to" in "target
4047	// update".
4048	if (GetContext().directive == llvm::omp::OMPD_declare_target) {
4049	return;
4050	}
4051
4052	assert(GetContext().directive == llvm::omp::OMPD_target_update);
4053	if (auto *iter{OmpGetUniqueModifier<parser::OmpIterator>(modifiers)}) {
4054	CheckIteratorModifier(*iter);
4055	}
4056
4057	const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
4058	SymbolSourceMap symbols;
4059	GetSymbolsInObjectList(objList, symbols);
4060	CheckVariableListItem(symbols);
4061
4062	// Ref: [4.5:109:19]
4063	// If a list item is an array section it must specify contiguous storage.
4064	if (version <= 45) {
4065	for (const parser::OmpObject &object : objList.v) {
4066	CheckIfContiguous(object);
4067	}
4068	}
4069	}
4070
4071	void OmpStructureChecker::Enter(const parser::OmpClause::OmpxBare &x) {
4072	// Don't call CheckAllowedClause, because it allows "ompx_bare" on
4073	// a non-combined "target" directive (for reasons of splitting combined
4074	// directives). In source code it's only allowed on "target teams".
4075	if (GetContext().directive != llvm::omp::Directive::OMPD_target_teams) {
4076	context_.Say(GetContext().clauseSource,
4077	"%s clause is only allowed on combined TARGET TEAMS"_err_en_US,
4078	parser::ToUpperCaseLetters(getClauseName(llvm::omp::OMPC_ompx_bare)));
4079	}
4080	}
4081
4082	llvm::StringRef OmpStructureChecker::getClauseName(llvm::omp::Clause clause) {
4083	return llvm::omp::getOpenMPClauseName(C: clause);
4084	}
4085
4086	llvm::StringRef OmpStructureChecker::getDirectiveName(
4087	llvm::omp::Directive directive) {
4088	unsigned version{context_.langOptions().OpenMPVersion};
4089	return llvm::omp::getOpenMPDirectiveName(D: directive, Ver: version);
4090	}
4091
4092	void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
4093	common::visit(
4094	common::visitors{
4095	[&](const common::Indirection<parser::ArrayElement> &elem) {
4096	// Check if the base element is valid on Depend Clause
4097	CheckDependList(elem.value().base);
4098	},
4099	[&](const common::Indirection<parser::StructureComponent> &comp) {
4100	CheckDependList(comp.value().base);
4101	},
4102	[&](const common::Indirection<parser::CoindexedNamedObject> &) {
4103	context_.Say(GetContext().clauseSource,
4104	"Coarrays are not supported in DEPEND clause"_err_en_US);
4105	},
4106	[&](const parser::Name &) {},
4107	},
4108	d.u);
4109	}
4110
4111	// Called from both Reduction and Depend clause.
4112	void OmpStructureChecker::CheckArraySection(
4113	const parser::ArrayElement &arrayElement, const parser::Name &name,
4114	const llvm::omp::Clause clause) {
4115	// Sometimes substring operations are incorrectly parsed as array accesses.
4116	// Detect this by looking for array accesses on character variables which are
4117	// not arrays.
4118	bool isSubstring{false};
4119	// Cannot analyze a base of an assumed-size array on its own. If we know
4120	// this is an array (assumed-size or not) we can ignore it, since we're
4121	// looking for strings.
4122	if (!IsAssumedSizeArray(*name.symbol)) {
4123	evaluate::ExpressionAnalyzer ea{context_};
4124	if (MaybeExpr expr = ea.Analyze(arrayElement.base)) {
4125	if (expr->Rank() == 0) {
4126	// Not an array: rank 0
4127	if (std::optional<evaluate::DynamicType> type = expr->GetType()) {
4128	if (type->category() == evaluate::TypeCategory::Character) {
4129	// Substrings are explicitly denied by the standard [6.0:163:9-11].
4130	// This is supported as an extension. This restriction was added in
4131	// OpenMP 5.2.
4132	isSubstring = true;
4133	context_.Say(GetContext().clauseSource,
4134	"The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2."_port_en_US);
4135	} else {
4136	llvm_unreachable(
4137	"Array indexing on a variable that isn't an array");
4138	}
4139	}
4140	}
4141	}
4142	}
4143	if (!arrayElement.subscripts.empty()) {
4144	for (const auto &subscript : arrayElement.subscripts) {
4145	if (const auto *triplet{
4146	std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
4147	if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
4148	std::optional<int64_t> strideVal{std::nullopt};
4149	if (const auto &strideExpr = std::get<2>(triplet->t)) {
4150	// OpenMP 6.0 Section 5.2.5: Array Sections
4151	// Restrictions: if a stride expression is specified it must be
4152	// positive. A stride of 0 doesn't make sense.
4153	strideVal = GetIntValue(strideExpr);
4154	if (strideVal && *strideVal < 1) {
4155	context_.Say(GetContext().clauseSource,
4156	"'%s' in %s clause must have a positive stride"_err_en_US,
4157	name.ToString(),
4158	parser::ToUpperCaseLetters(getClauseName(clause).str()));
4159	}
4160	if (isSubstring) {
4161	context_.Say(GetContext().clauseSource,
4162	"Cannot specify a step for a substring"_err_en_US);
4163	}
4164	}
4165	const auto &lower{std::get<0>(triplet->t)};
4166	const auto &upper{std::get<1>(triplet->t)};
4167	if (lower && upper) {
4168	const auto lval{GetIntValue(lower)};
4169	const auto uval{GetIntValue(upper)};
4170	if (lval && uval) {
4171	int64_t sectionLen = *uval - *lval;
4172	if (strideVal) {
4173	sectionLen = sectionLen / *strideVal;
4174	}
4175
4176	if (sectionLen < 1) {
4177	context_.Say(GetContext().clauseSource,
4178	"'%s' in %s clause"
4179	" is a zero size array section"_err_en_US,
4180	name.ToString(),
4181	parser::ToUpperCaseLetters(getClauseName(clause).str()));
4182	break;
4183	}
4184	}
4185	}
4186	}
4187	} else if (std::get_if<parser::IntExpr>(&subscript.u)) {
4188	// base(n) is valid as an array index but not as a substring operation
4189	if (isSubstring) {
4190	context_.Say(GetContext().clauseSource,
4191	"Substrings must be in the form parent-string(lb:ub)"_err_en_US);
4192	}
4193	}
4194	}
4195	}
4196	}
4197
4198	void OmpStructureChecker::CheckIntentInPointer(
4199	SymbolSourceMap &symbols, llvm::omp::Clause clauseId) {
4200	for (auto &[symbol, source] : symbols) {
4201	if (IsPointer(*symbol) && IsIntentIn(*symbol)) {
4202	context_.Say(source,
4203	"Pointer '%s' with the INTENT(IN) attribute may not appear in a %s clause"_err_en_US,
4204	symbol->name(),
4205	parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
4206	}
4207	}
4208	}
4209
4210	void OmpStructureChecker::CheckProcedurePointer(
4211	SymbolSourceMap &symbols, llvm::omp::Clause clause) {
4212	for (const auto &[symbol, source] : symbols) {
4213	if (IsProcedurePointer(*symbol)) {
4214	context_.Say(source,
4215	"Procedure pointer '%s' may not appear in a %s clause"_err_en_US,
4216	symbol->name(),
4217	parser::ToUpperCaseLetters(getClauseName(clause).str()));
4218	}
4219	}
4220	}
4221
4222	void OmpStructureChecker::CheckCrayPointee(
4223	const parser::OmpObjectList &objectList, llvm::StringRef clause,
4224	bool suggestToUseCrayPointer) {
4225	SymbolSourceMap symbols;
4226	GetSymbolsInObjectList(objectList, symbols);
4227	for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
4228	const auto *symbol{it->first};
4229	const auto source{it->second};
4230	if (symbol->test(Symbol::Flag::CrayPointee)) {
4231	std::string suggestionMsg = "";
4232	if (suggestToUseCrayPointer)
4233	suggestionMsg = ", use Cray Pointer '" +
4234	semantics::GetCrayPointer(*symbol).name().ToString() + "' instead";
4235	context_.Say(source,
4236	"Cray Pointee '%s' may not appear in %s clause%s"_err_en_US,
4237	symbol->name(), clause.str(), suggestionMsg);
4238	}
4239	}
4240	}
4241
4242	void OmpStructureChecker::GetSymbolsInObjectList(
4243	const parser::OmpObjectList &objectList, SymbolSourceMap &symbols) {
4244	for (const auto &ompObject : objectList.v) {
4245	if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
4246	if (const auto *symbol{name->symbol}) {
4247	if (const auto *commonBlockDetails{
4248	symbol->detailsIf<CommonBlockDetails>()}) {
4249	for (const auto &object : commonBlockDetails->objects()) {
4250	symbols.emplace(&object->GetUltimate(), name->source);
4251	}
4252	} else {
4253	symbols.emplace(&symbol->GetUltimate(), name->source);
4254	}
4255	}
4256	}
4257	}
4258	}
4259
4260	void OmpStructureChecker::CheckDefinableObjects(
4261	SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
4262	for (auto &[symbol, source] : symbols) {
4263	if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
4264	DefinabilityFlags{}, *symbol)}) {
4265	context_
4266	.Say(source,
4267	"Variable '%s' on the %s clause is not definable"_err_en_US,
4268	symbol->name(),
4269	parser::ToUpperCaseLetters(getClauseName(clause).str()))
4270	.Attach(std::move(msg->set_severity(parser::Severity::Because)));
4271	}
4272	}
4273	}
4274
4275	void OmpStructureChecker::CheckPrivateSymbolsInOuterCxt(
4276	SymbolSourceMap &currSymbols, DirectivesClauseTriple &dirClauseTriple,
4277	const llvm::omp::Clause currClause) {
4278	SymbolSourceMap enclosingSymbols;
4279	auto range{dirClauseTriple.equal_range(GetContext().directive)};
4280	for (auto dirIter{range.first}; dirIter != range.second; ++dirIter) {
4281	auto enclosingDir{dirIter->second.first};
4282	auto enclosingClauseSet{dirIter->second.second};
4283	if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
4284	for (auto it{enclosingContext->clauseInfo.begin()};
4285	it != enclosingContext->clauseInfo.end(); ++it) {
4286	if (enclosingClauseSet.test(it->first)) {
4287	if (const auto *ompObjectList{GetOmpObjectList(*it->second)}) {
4288	GetSymbolsInObjectList(*ompObjectList, enclosingSymbols);
4289	}
4290	}
4291	}
4292
4293	// Check if the symbols in current context are private in outer context
4294	for (auto &[symbol, source] : currSymbols) {
4295	if (enclosingSymbols.find(symbol) != enclosingSymbols.end()) {
4296	context_.Say(source,
4297	"%s variable '%s' is PRIVATE in outer context"_err_en_US,
4298	parser::ToUpperCaseLetters(getClauseName(currClause).str()),
4299	symbol->name());
4300	}
4301	}
4302	}
4303	}
4304	}
4305
4306	bool OmpStructureChecker::CheckTargetBlockOnlyTeams(
4307	const parser::Block &block) {
4308	bool nestedTeams{false};
4309
4310	if (!block.empty()) {
4311	auto it{block.begin()};
4312	if (const auto *ompConstruct{
4313	parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
4314	if (const auto *ompBlockConstruct{
4315	std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
4316	const auto &beginBlockDir{
4317	std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
4318	const auto &beginDir{
4319	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
4320	if (beginDir.v == llvm::omp::Directive::OMPD_teams) {
4321	nestedTeams = true;
4322	}
4323	}
4324	}
4325
4326	if (nestedTeams && ++it == block.end()) {
4327	return true;
4328	}
4329	}
4330
4331	return false;
4332	}
4333
4334	void OmpStructureChecker::CheckWorkshareBlockStmts(
4335	const parser::Block &block, parser::CharBlock source) {
4336	OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
4337
4338	for (auto it{block.begin()}; it != block.end(); ++it) {
4339	if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
4340	parser::Unwrap<parser::ForallStmt>(*it) ||
4341	parser::Unwrap<parser::ForallConstruct>(*it) ||
4342	parser::Unwrap<parser::WhereStmt>(*it) ||
4343	parser::Unwrap<parser::WhereConstruct>(*it)) {
4344	parser::Walk(*it, ompWorkshareBlockChecker);
4345	} else if (const auto *ompConstruct{
4346	parser::Unwrap<parser::OpenMPConstruct>(*it)}) {
4347	if (const auto *ompAtomicConstruct{
4348	std::get_if<parser::OpenMPAtomicConstruct>(&ompConstruct->u)}) {
4349	// Check if assignment statements in the enclosing OpenMP Atomic
4350	// construct are allowed in the Workshare construct
4351	parser::Walk(*ompAtomicConstruct, ompWorkshareBlockChecker);
4352	} else if (const auto *ompCriticalConstruct{
4353	std::get_if<parser::OpenMPCriticalConstruct>(
4354	&ompConstruct->u)}) {
4355	// All the restrictions on the Workshare construct apply to the
4356	// statements in the enclosing critical constructs
4357	const auto &criticalBlock{
4358	std::get<parser::Block>(ompCriticalConstruct->t)};
4359	CheckWorkshareBlockStmts(criticalBlock, source);
4360	} else {
4361	// Check if OpenMP constructs enclosed in the Workshare construct are
4362	// 'Parallel' constructs
4363	auto currentDir{llvm::omp::Directive::OMPD_unknown};
4364	if (const auto *ompBlockConstruct{
4365	std::get_if<parser::OpenMPBlockConstruct>(&ompConstruct->u)}) {
4366	const auto &beginBlockDir{
4367	std::get<parser::OmpBeginBlockDirective>(ompBlockConstruct->t)};
4368	const auto &beginDir{
4369	std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
4370	currentDir = beginDir.v;
4371	} else if (const auto *ompLoopConstruct{
4372	std::get_if<parser::OpenMPLoopConstruct>(
4373	&ompConstruct->u)}) {
4374	const auto &beginLoopDir{
4375	std::get<parser::OmpBeginLoopDirective>(ompLoopConstruct->t)};
4376	const auto &beginDir{
4377	std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
4378	currentDir = beginDir.v;
4379	} else if (const auto *ompSectionsConstruct{
4380	std::get_if<parser::OpenMPSectionsConstruct>(
4381	&ompConstruct->u)}) {
4382	const auto &beginSectionsDir{
4383	std::get<parser::OmpBeginSectionsDirective>(
4384	ompSectionsConstruct->t)};
4385	const auto &beginDir{
4386	std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
4387	currentDir = beginDir.v;
4388	}
4389
4390	if (!llvm::omp::topParallelSet.test(currentDir)) {
4391	context_.Say(source,
4392	"OpenMP constructs enclosed in WORKSHARE construct may consist "
4393	"of ATOMIC, CRITICAL or PARALLEL constructs only"_err_en_US);
4394	}
4395	}
4396	} else {
4397	context_.Say(source,
4398	"The structured block in a WORKSHARE construct may consist of only "
4399	"SCALAR or ARRAY assignments, FORALL or WHERE statements, "
4400	"FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
4401	}
4402	}
4403	}
4404
4405	void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {
4406	if (auto contig{IsContiguous(context_, object)}; contig && !*contig) {
4407	const parser::Name *name{GetObjectName(object)};
4408	assert(name && "Expecting name component");
4409	context_.Say(name->source,
4410	"Reference to '%s' must be a contiguous object"_err_en_US,
4411	name->ToString());
4412	}
4413	}
4414
4415	namespace {
4416	struct NameHelper {
4417	template <typename T>
4418	static const parser::Name *Visit(const common::Indirection<T> &x) {
4419	return Visit(x.value());
4420	}
4421	static const parser::Name *Visit(const parser::Substring &x) {
4422	return Visit(std::get<parser::DataRef>(x.t));
4423	}
4424	static const parser::Name *Visit(const parser::ArrayElement &x) {
4425	return Visit(x.base);
4426	}
4427	static const parser::Name *Visit(const parser::Designator &x) {
4428	return common::visit([](auto &&s) { return Visit(s); }, x.u);
4429	}
4430	static const parser::Name *Visit(const parser::DataRef &x) {
4431	return common::visit([](auto &&s) { return Visit(s); }, x.u);
4432	}
4433	static const parser::Name *Visit(const parser::OmpObject &x) {
4434	return common::visit([](auto &&s) { return Visit(s); }, x.u);
4435	}
4436	template <typename T> static const parser::Name *Visit(T &&) {
4437	return nullptr;
4438	}
4439	static const parser::Name *Visit(const parser::Name &x) { return &x; }
4440	};
4441	} // namespace
4442
4443	const parser::Name *OmpStructureChecker::GetObjectName(
4444	const parser::OmpObject &object) {
4445	return NameHelper::Visit(object);
4446	}
4447
4448	const parser::OmpObjectList *OmpStructureChecker::GetOmpObjectList(
4449	const parser::OmpClause &clause) {
4450
4451	// Clauses with OmpObjectList as its data member
4452	using MemberObjectListClauses = std::tuple<parser::OmpClause::Copyprivate,
4453	parser::OmpClause::Copyin, parser::OmpClause::Enter,
4454	parser::OmpClause::Firstprivate, parser::OmpClause::Link,
4455	parser::OmpClause::Private, parser::OmpClause::Shared,
4456	parser::OmpClause::UseDevicePtr, parser::OmpClause::UseDeviceAddr>;
4457
4458	// Clauses with OmpObjectList in the tuple
4459	using TupleObjectListClauses = std::tuple<parser::OmpClause::Aligned,
4460	parser::OmpClause::Allocate, parser::OmpClause::From,
4461	parser::OmpClause::Lastprivate, parser::OmpClause::Map,
4462	parser::OmpClause::Reduction, parser::OmpClause::To>;
4463
4464	// TODO:: Generate the tuples using TableGen.
4465	// Handle other constructs with OmpObjectList such as OpenMPThreadprivate.
4466	return common::visit(
4467	common::visitors{
4468	[&](const auto &x) -> const parser::OmpObjectList * {
4469	using Ty = std::decay_t<decltype(x)>;
4470	if constexpr (common::HasMember<Ty, MemberObjectListClauses>) {
4471	return &x.v;
4472	} else if constexpr (common::HasMember<Ty,
4473	TupleObjectListClauses>) {
4474	return &(std::get<parser::OmpObjectList>(x.v.t));
4475	} else {
4476	return nullptr;
4477	}
4478	},
4479	},
4480	clause.u);
4481	}
4482
4483	void OmpStructureChecker::Enter(
4484	const parser::OmpClause::AtomicDefaultMemOrder &x) {
4485	CheckAllowedRequiresClause(clause: llvm::omp::Clause::OMPC_atomic_default_mem_order);
4486	}
4487
4488	void OmpStructureChecker::Enter(const parser::OmpClause::DynamicAllocators &x) {
4489	CheckAllowedRequiresClause(clause: llvm::omp::Clause::OMPC_dynamic_allocators);
4490	}
4491
4492	void OmpStructureChecker::Enter(const parser::OmpClause::ReverseOffload &x) {
4493	CheckAllowedRequiresClause(clause: llvm::omp::Clause::OMPC_reverse_offload);
4494	}
4495
4496	void OmpStructureChecker::Enter(const parser::OmpClause::UnifiedAddress &x) {
4497	CheckAllowedRequiresClause(clause: llvm::omp::Clause::OMPC_unified_address);
4498	}
4499
4500	void OmpStructureChecker::Enter(
4501	const parser::OmpClause::UnifiedSharedMemory &x) {
4502	CheckAllowedRequiresClause(clause: llvm::omp::Clause::OMPC_unified_shared_memory);
4503	}
4504
4505	void OmpStructureChecker::Enter(const parser::OmpClause::SelfMaps &x) {
4506	CheckAllowedRequiresClause(clause: llvm::omp::Clause::OMPC_self_maps);
4507	}
4508
4509	void OmpStructureChecker::Enter(const parser::OpenMPInteropConstruct &x) {
4510	bool isDependClauseOccured{false};
4511	int targetCount{0}, targetSyncCount{0};
4512	const auto &dir{std::get<parser::OmpDirectiveName>(x.v.t)};
4513	std::set<const Symbol *> objectSymbolList;
4514	PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_interop);
4515	const auto &clauseList{std::get<std::optional<parser::OmpClauseList>>(x.v.t)};
4516	for (const auto &clause : clauseList->v) {
4517	common::visit(
4518	common::visitors{
4519	[&](const parser::OmpClause::Init &initClause) {
4520	if (OmpVerifyModifiers(initClause.v, llvm::omp::OMPC_init,
4521	GetContext().directiveSource, context_)) {
4522
4523	auto &modifiers{OmpGetModifiers(initClause.v)};
4524	auto &&interopTypeModifier{
4525	OmpGetRepeatableModifier<parser::OmpInteropType>(
4526	modifiers)};
4527	for (const auto &it : interopTypeModifier) {
4528	if (it->v == parser::OmpInteropType::Value::TargetSync) {
4529	++targetSyncCount;
4530	} else {
4531	++targetCount;
4532	}
4533	}
4534	}
4535	const auto &interopVar{parser::Unwrap<parser::OmpObject>(
4536	std::get<parser::OmpObject>(initClause.v.t))};
4537	const auto *name{parser::Unwrap<parser::Name>(interopVar)};
4538	const auto *objectSymbol{name->symbol};
4539	if (llvm::is_contained(objectSymbolList, objectSymbol)) {
4540	context_.Say(GetContext().directiveSource,
4541	"Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
4542	} else {
4543	objectSymbolList.insert(objectSymbol);
4544	}
4545	},
4546	[&](const parser::OmpClause::Depend &dependClause) {
4547	isDependClauseOccured = true;
4548	},
4549	[&](const parser::OmpClause::Destroy &destroyClause) {
4550	const auto &interopVar{
4551	parser::Unwrap<parser::OmpObject>(destroyClause.v)};
4552	const auto *name{parser::Unwrap<parser::Name>(interopVar)};
4553	const auto *objectSymbol{name->symbol};
4554	if (llvm::is_contained(objectSymbolList, objectSymbol)) {
4555	context_.Say(GetContext().directiveSource,
4556	"Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
4557	} else {
4558	objectSymbolList.insert(objectSymbol);
4559	}
4560	},
4561	[&](const parser::OmpClause::Use &useClause) {
4562	const auto &interopVar{
4563	parser::Unwrap<parser::OmpObject>(useClause.v)};
4564	const auto *name{parser::Unwrap<parser::Name>(interopVar)};
4565	const auto *objectSymbol{name->symbol};
4566	if (llvm::is_contained(objectSymbolList, objectSymbol)) {
4567	context_.Say(GetContext().directiveSource,
4568	"Each interop-var may be specified for at most one action-clause of each INTEROP construct."_err_en_US);
4569	} else {
4570	objectSymbolList.insert(objectSymbol);
4571	}
4572	},
4573	[&](const auto &) {},
4574	},
4575	clause.u);
4576	}
4577	if (targetCount > 1 || targetSyncCount > 1) {
4578	context_.Say(GetContext().directiveSource,
4579	"Each interop-type may be specified at most once."_err_en_US);
4580	}
4581	if (isDependClauseOccured && !targetSyncCount) {
4582	context_.Say(GetContext().directiveSource,
4583	"A DEPEND clause can only appear on the directive if the interop-type includes TARGETSYNC"_err_en_US);
4584	}
4585	}
4586
4587	void OmpStructureChecker::Leave(const parser::OpenMPInteropConstruct &) {
4588	dirContext_.pop_back();
4589	}
4590
4591	void OmpStructureChecker::CheckAllowedRequiresClause(llvmOmpClause clause) {
4592	CheckAllowedClause(clause);
4593
4594	if (clause != llvm::omp::Clause::OMPC_atomic_default_mem_order) {
4595	// Check that it does not appear after a device construct
4596	if (deviceConstructFound_) {
4597	context_.Say(GetContext().clauseSource,
4598	"REQUIRES directive with '%s' clause found lexically after device "
4599	"construct"_err_en_US,
4600	parser::ToUpperCaseLetters(getClauseName(clause).str()));
4601	}
4602	}
4603	}
4604
4605	} // namespace Fortran::semantics
4606