Skip to content

Commit 205a760

Browse files
kparzyszkparzysz
committed
support for default
1 parent 4c5b3ce commit 205a760

File tree

7 files changed

+116
-44
lines changed

7 files changed

+116
-44
lines changed

‎flang/include/flang/Parser/parse-tree.h‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3967,15 +3967,21 @@ struct OmpBindClause {
39673967

39683968
// Ref: [4.5:46-50], [5.0:74-78], [5.1:92-96], [5.2:109]
39693969
//
3970+
// When used as a data-sharing clause:
39703971
// default-clause ->
39713972
// DEFAULT(data-sharing-attribute) // since 4.5
39723973
// data-sharing-attribute ->
39733974
// SHARED | NONE | // since 4.5
39743975
// PRIVATE | FIRSTPRIVATE // since 5.0
3976+
//
3977+
// When used in METADIRECTIVE:
3978+
// default-clause ->
3979+
// DEFAULT(directive-specification) // since 5.0, until 5.1
39753980
// See also otherwise-clause.
39763981
struct OmpDefaultClause {
39773982
ENUM_CLASS(DataSharingAttribute, Private, Firstprivate, Shared, None)
3978-
WRAPPER_CLASS_BOILERPLATE(OmpDefaultClause, DataSharingAttribute);
3983+
UNION_CLASS_BOILERPLATE(OmpDefaultClause);
3984+
std::variant<DataSharingAttribute, OmpDirectiveSpecification> u;
39793985
};
39803986

39813987
// Ref: [4.5:103-107], [5.0:324-325], [5.1:357-358], [5.2:161-162]

‎flang/lib/Lower/OpenMP/Clauses.cpp‎

Lines changed: 30 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -230,9 +230,6 @@ MAKE_EMPTY_CLASS(Threadprivate, Threadprivate);
230230

231231
MAKE_INCOMPLETE_CLASS(AdjustArgs, AdjustArgs);
232232
MAKE_INCOMPLETE_CLASS(AppendArgs, AppendArgs);
233-
// MAKE_INCOMPLETE_CLASS(Match, Match);
234-
// MAKE_INCOMPLETE_CLASS(Otherwise, ); // missing-in-parser
235-
// MAKE_INCOMPLETE_CLASS(When, When);
236233

237234
List<IteratorSpecifier>
238235
makeIteratorSpecifiers(const parser::OmpIteratorSpecifier &inp,
@@ -528,8 +525,13 @@ Copyprivate make(const parser::OmpClause::Copyprivate &inp,
528525
return Copyprivate{/*List=*/makeObjects(inp.v, semaCtx)};
529526
}
530527

531-
Default make(const parser::OmpClause::Default &inp,
532-
semantics::SemanticsContext &semaCtx) {
528+
// The Default clause is overloaded in OpenMP 5.0 and 5.1: it can be either
529+
// a data-sharing clause, or a METADIRECTIVE clause. In the latter case, it
530+
// has been superseded by the OTHERWISE clause.
531+
// Disambiguate this in this representation: for the DSA case, create Default,
532+
// and in the other case create Otherwise.
533+
Default makeDefault(const parser::OmpClause::Default &inp,
534+
semantics::SemanticsContext &semaCtx) {
533535
// inp.v -> parser::OmpDefaultClause
534536
using wrapped = parser::OmpDefaultClause;
535537

@@ -543,7 +545,13 @@ Default make(const parser::OmpClause::Default &inp,
543545
// clang-format on
544546
);
545547

546-
return Default{/*DataSharingAttribute=*/convert(inp.v.v)};
548+
auto dsa = std::get<wrapped::DataSharingAttribute>(inp.v.u);
549+
return Default{/*DataSharingAttribute=*/convert(dsa)};
550+
}
551+
552+
Otherwise makeOtherwise(const parser::OmpClause::Default &inp,
553+
semantics::SemanticsContext &semaCtx) {
554+
return Otherwise{};
547555
}
548556

549557
Defaultmap make(const parser::OmpClause::Defaultmap &inp,
@@ -1105,7 +1113,7 @@ Ordered make(const parser::OmpClause::Ordered &inp,
11051113
return Ordered{/*N=*/maybeApply(makeExprFn(semaCtx), inp.v)};
11061114
}
11071115

1108-
// Otherwise: incomplete, missing-in-parser
1116+
// See also Default.
11091117
Otherwise make(const parser::OmpClause::Otherwise &inp,
11101118
semantics::SemanticsContext &semaCtx) {
11111119
return Otherwise{};
@@ -1375,9 +1383,21 @@ When make(const parser::OmpClause::When &inp,
13751383

13761384
Clause makeClause(const parser::OmpClause &cls,
13771385
semantics::SemanticsContext &semaCtx) {
1378-
return Fortran::common::visit(
1379-
[&](auto &&s) {
1380-
return makeClause(cls.Id(), clause::make(s, semaCtx), cls.source);
1386+
return Fortran::common::visit( //
1387+
common::visitors{
1388+
[&](const parser::OmpClause::Default &s) {
1389+
using DSA = parser::OmpDefaultClause::DataSharingAttribute;
1390+
if (std::holds_alternative<DSA>(s.v.u)) {
1391+
return makeClause(llvm::omp::Clause::OMPC_default,
1392+
clause::makeDefault(s, semaCtx), cls.source);
1393+
} else {
1394+
return makeClause(llvm::omp::Clause::OMPC_otherwise,
1395+
clause::makeOtherwise(s, semaCtx), cls.source);
1396+
}
1397+
},
1398+
[&](auto &&s) {
1399+
return makeClause(cls.Id(), clause::make(s, semaCtx), cls.source);
1400+
},
13811401
},
13821402
cls.u);
13831403
}

‎flang/lib/Parser/openmp-parsers.cpp‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -533,13 +533,18 @@ TYPE_PARSER(construct<OmpAffinityClause>(
533533
Parser<OmpObjectList>{}))
534534

535535
// 2.15.3.1 DEFAULT (PRIVATE | FIRSTPRIVATE | SHARED | NONE)
536-
TYPE_PARSER(construct<OmpDefaultClause>(
536+
TYPE_PARSER(construct<OmpDefaultClause::DataSharingAttribute>(
537537
"PRIVATE" >> pure(OmpDefaultClause::DataSharingAttribute::Private) ||
538538
"FIRSTPRIVATE" >>
539539
pure(OmpDefaultClause::DataSharingAttribute::Firstprivate) ||
540540
"SHARED" >> pure(OmpDefaultClause::DataSharingAttribute::Shared) ||
541541
"NONE" >> pure(OmpDefaultClause::DataSharingAttribute::None)))
542542

543+
TYPE_PARSER(construct<OmpDefaultClause>(
544+
construct<OmpDefaultClause>(
545+
Parser<OmpDefaultClause::DataSharingAttribute>{}) ||
546+
construct<OmpDefaultClause>(Parser<OmpDirectiveSpecification>{})))
547+
543548
// 2.5 PROC_BIND (MASTER | CLOSE | PRIMARY | SPREAD)
544549
TYPE_PARSER(construct<OmpProcBindClause>(
545550
"CLOSE" >> pure(OmpProcBindClause::AffinityPolicy::Close) ||

‎flang/lib/Semantics/check-omp-structure.cpp‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -215,6 +215,11 @@ class AssociatedLoopChecker {
215215

216216
bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
217217
// Do not do clause checks while processing METADIRECTIVE.
218+
// Context selectors can contain clauses that are not given as a part
219+
// of a construct, but as trait properties. Testing whether they are
220+
// valid or not is deferred to the checks of the context selectors.
221+
// As it stands now, these clauses would appear as if they were present
222+
// on METADIRECTIVE, leading to incorrect diagnostics.
218223
if (GetDirectiveNest(ContextSelectorNest) > 0) {
219224
return true;
220225
}

‎flang/lib/Semantics/resolve-directives.cpp‎

Lines changed: 19 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -2028,20 +2028,25 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) {
20282028
}
20292029

20302030
void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
2031-
if (!dirContext_.empty()) {
2032-
switch (x.v) {
2033-
case parser::OmpDefaultClause::DataSharingAttribute::Private:
2034-
SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
2035-
break;
2036-
case parser::OmpDefaultClause::DataSharingAttribute::Firstprivate:
2037-
SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
2038-
break;
2039-
case parser::OmpDefaultClause::DataSharingAttribute::Shared:
2040-
SetContextDefaultDSA(Symbol::Flag::OmpShared);
2041-
break;
2042-
case parser::OmpDefaultClause::DataSharingAttribute::None:
2043-
SetContextDefaultDSA(Symbol::Flag::OmpNone);
2044-
break;
2031+
// The DEFAULT clause may also be used on METADIRECTIVE. In that case
2032+
// there is nothing to do.
2033+
using DataSharingAttribute = parser::OmpDefaultClause::DataSharingAttribute;
2034+
if (auto *dsa{std::get_if<DataSharingAttribute>(&x.u)}) {
2035+
if (!dirContext_.empty()) {
2036+
switch (*dsa) {
2037+
case DataSharingAttribute::Private:
2038+
SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
2039+
break;
2040+
case DataSharingAttribute::Firstprivate:
2041+
SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
2042+
break;
2043+
case DataSharingAttribute::Shared:
2044+
SetContextDefaultDSA(Symbol::Flag::OmpShared);
2045+
break;
2046+
case DataSharingAttribute::None:
2047+
SetContextDefaultDSA(Symbol::Flag::OmpNone);
2048+
break;
2049+
}
20452050
}
20462051
}
20472052
}

‎flang/test/Parser/OpenMP/metadirective-v50.f90‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
!RUN: %flang_fc1 -fdebug-unparse -fopenmp -fopenmp-version=50 %s | FileCheck --ignore-case --check-prefix="UNPARSE" %s
2+
!RUN: %flang_fc1 -fdebug-dump-parse-tree -fopenmp -fopenmp-version=50 %s | FileCheck --check-prefix="PARSE-TREE" %s
3+
4+
subroutine f01
5+
!$omp metadirective &
6+
!$omp & when(user={condition(.true.)}: nothing) &
7+
!$omp & default(nothing)
8+
end
9+
10+
!UNPARSE: SUBROUTINE f01
11+
!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(.true._4)}: NOTHING) DEFAULT(NOTHING)
12+
!UNPARSE: END SUBROUTINE
13+
14+
!PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OmpMetadirectiveDirective
15+
!PARSE-TREE: | OmpClauseList -> OmpClause -> When -> OmpWhenClause
16+
!PARSE-TREE: | | Modifier -> OmpContextSelectorSpecification -> OmpTraitSetSelector
17+
!PARSE-TREE: | | | OmpTraitSetSelectorName -> Value = User
18+
!PARSE-TREE: | | | OmpTraitSelector
19+
!PARSE-TREE: | | | | OmpTraitSelectorName -> Value = Condition
20+
!PARSE-TREE: | | | | Properties
21+
!PARSE-TREE: | | | | | OmpTraitProperty -> Scalar -> Expr = '.true._4'
22+
!PARSE-TREE: | | | | | | LiteralConstant -> LogicalLiteralConstant
23+
!PARSE-TREE: | | | | | | | bool = 'true'
24+
!PARSE-TREE: | | OmpDirectiveSpecification
25+
!PARSE-TREE: | | | llvm::omp::Directive = nothing
26+
!PARSE-TREE: | | | OmpClauseList ->
27+
!PARSE-TREE: | OmpClause -> Default -> OmpDefaultClause -> OmpDirectiveSpecification
28+
!PARSE-TREE: | | llvm::omp::Directive = nothing
29+
!PARSE-TREE: | | OmpClauseList ->

‎flang/test/Parser/OpenMP/metadirective.f90‎

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,11 @@ subroutine f00
2121
!PARSE-TREE: | | | llvm::omp::Directive = nothing
2222
!PARSE-TREE: | | | OmpClauseList ->
2323

24-
subroutine f10
24+
subroutine f01
2525
!$omp metadirective when(device={kind(host), device_num(1)}: nothing)
2626
end
2727

28-
!UNPARSE: SUBROUTINE f10
28+
!UNPARSE: SUBROUTINE f01
2929
!UNPARSE: !$OMP METADIRECTIVE WHEN(DEVICE={KIND(host), DEVICE_NUM(1_4)}: NOTHING)
3030
!UNPARSE: END SUBROUTINE
3131

@@ -46,11 +46,11 @@ subroutine f10
4646
!PARSE-TREE: | | | llvm::omp::Directive = nothing
4747
!PARSE-TREE: | | | OmpClauseList ->
4848

49-
subroutine f20
49+
subroutine f02
5050
!$omp metadirective when(target_device={kind(any), device_num(7)}: nothing)
5151
end
5252

53-
!UNPARSE: SUBROUTINE f20
53+
!UNPARSE: SUBROUTINE f02
5454
!UNPARSE: !$OMP METADIRECTIVE WHEN(TARGET_DEVICE={KIND(any), DEVICE_NUM(7_4)}: NOTHING)
5555
!UNPARSE: END SUBROUTINE
5656

@@ -71,12 +71,12 @@ subroutine f20
7171
!PARSE-TREE: | | | llvm::omp::Directive = nothing
7272
!PARSE-TREE: | | | OmpClauseList ->
7373

74-
subroutine f30
74+
subroutine f03
7575
!$omp metadirective &
76-
!$omp when(implementation={atomic_default_mem_order(acq_rel)}: nothing)
76+
!$omp & when(implementation={atomic_default_mem_order(acq_rel)}: nothing)
7777
end
7878

79-
!UNPARSE: SUBROUTINE f30
79+
!UNPARSE: SUBROUTINE f03
8080
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={ATOMIC_DEFAULT_MEM_ORDER(ACQ_REL)}: &
8181
!UNPARSE: !$OMP&NOTHING)
8282
!UNPARSE: END SUBROUTINE
@@ -93,12 +93,12 @@ subroutine f30
9393
!PARSE-TREE: | | | llvm::omp::Directive = nothing
9494
!PARSE-TREE: | | | OmpClauseList ->
9595

96-
subroutine f31
96+
subroutine f04
9797
!$omp metadirective &
98-
!$omp when(implementation={extension(haha(1), foo(baz, "bar"(1)))}: nothing)
98+
!$omp & when(implementation={extension(haha(1), foo(baz, "bar"(1)))}: nothing)
9999
end
100100

101-
!UNPARSE: SUBROUTINE f31
101+
!UNPARSE: SUBROUTINE f04
102102
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={EXTENSION(haha(1_4), foo(baz,bar(1_4)))}: &
103103
!UNPARSE: !$OMP&NOTHING)
104104
!UNPARSE: END SUBROUTINE
@@ -125,17 +125,17 @@ subroutine f31
125125
!PARSE-TREE: | | | llvm::omp::Directive = nothing
126126
!PARSE-TREE: | | | OmpClauseList ->
127127

128-
subroutine f40(x)
128+
subroutine f05(x)
129129
integer :: x
130130
!$omp metadirective &
131-
!$omp when(user={condition(score(100): .true.)}: &
132-
!$omp parallel do reduction(+: x)) &
133-
!$omp otherwise(nothing)
131+
!$omp & when(user={condition(score(100): .true.)}: &
132+
!$omp & parallel do reduction(+: x)) &
133+
!$omp & otherwise(nothing)
134134
do i = 1, 10
135135
enddo
136136
end
137137

138-
!UNPARSE: SUBROUTINE f40 (x)
138+
!UNPARSE: SUBROUTINE f05 (x)
139139
!UNPARSE: INTEGER x
140140
!UNPARSE: !$OMP METADIRECTIVE WHEN(USER={CONDITION(SCORE(100_4): .true._4)}: PARALLEL DO REDUCTION(+&
141141
!UNPARSE: !$OMP&: x)) OTHERWISE(NOTHING)
@@ -164,13 +164,14 @@ subroutine f40(x)
164164
!PARSE-TREE: | | llvm::omp::Directive = nothing
165165
!PARSE-TREE: | | OmpClauseList ->
166166

167-
subroutine f41
167+
subroutine f06
168168
! Two trait set selectors
169169
!$omp metadirective &
170-
!$omp when(implementation={vendor("amd")}, user={condition(.true.)}: nothing)
170+
!$omp & when(implementation={vendor("amd")}, &
171+
!$omp & user={condition(.true.)}: nothing)
171172
end
172173

173-
!UNPARSE: SUBROUTINE f41
174+
!UNPARSE: SUBROUTINE f06
174175
!UNPARSE: !$OMP METADIRECTIVE WHEN(IMPLEMENTATION={VENDOR(amd)}, USER={CONDITION(.true._4)}: NO&
175176
!UNPARSE: !$OMP&THING)
176177
!UNPARSE: END SUBROUTINE
@@ -194,3 +195,4 @@ subroutine f41
194195
!PARSE-TREE: | | OmpDirectiveSpecification
195196
!PARSE-TREE: | | | llvm::omp::Directive = nothing
196197
!PARSE-TREE: | | | OmpClauseList ->
198+

0 commit comments

Comments
 (0)