Skip to content

Commit 67ea943

Browse files
skc7skc7
committed
[flang] Add semantics checks for workdistribute construct.
1 parent 98705e4 commit 67ea943

File tree

6 files changed

+187
-36
lines changed

6 files changed

+187
-36
lines changed

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

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -141,6 +141,67 @@ class OmpWorkshareBlockChecker {
141141
parser::CharBlock source_;
142142
};
143143

144+
// 'OmpWorkdistributeBlockChecker' is used to check the validity of the
145+
// assignment statements and the expressions enclosed in an OpenMP
146+
// workdistribute construct
147+
class OmpWorkdistributeBlockChecker {
148+
public:
149+
OmpWorkdistributeBlockChecker(
150+
SemanticsContext &context, parser::CharBlock source)
151+
: context_{context}, source_{source} {}
152+
153+
template <typename T> bool Pre(const T &) { return true; }
154+
template <typename T> void Post(const T &) {}
155+
156+
bool Pre(const parser::AssignmentStmt &assignment) {
157+
const auto &var{std::get<parser::Variable>(assignment.t)};
158+
const auto &expr{std::get<parser::Expr>(assignment.t)};
159+
const auto *lhs{GetExpr(context_, var)};
160+
const auto *rhs{GetExpr(context_, expr)};
161+
if (lhs && rhs) {
162+
Tristate isDefined{semantics::IsDefinedAssignment(
163+
lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
164+
if (isDefined == Tristate::Yes) {
165+
context_.Say(expr.source,
166+
"Defined assignment statement is not "
167+
"allowed in a WORKDISTRIBUTE construct"_err_en_US);
168+
}
169+
}
170+
return true;
171+
}
172+
173+
bool Pre(const parser::Expr &expr) {
174+
if (const auto *e{GetExpr(context_, expr)}) {
175+
for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
176+
const Symbol &root{GetAssociationRoot(symbol)};
177+
if (IsFunction(root)) {
178+
std::string attrs{""};
179+
if (!IsElementalProcedure(root)) {
180+
attrs = " non-ELEMENTAL";
181+
}
182+
if (root.attrs().test(Attr::IMPURE)) {
183+
if (attrs != "") {
184+
attrs = "," + attrs;
185+
}
186+
attrs = " IMPURE" + attrs;
187+
}
188+
if (attrs != "") {
189+
context_.Say(expr.source,
190+
"User defined%s function '%s' is not allowed in a "
191+
"WORKDISTRIBUTE construct"_err_en_US,
192+
attrs, root.name());
193+
}
194+
}
195+
}
196+
}
197+
return false;
198+
}
199+
200+
private:
201+
SemanticsContext &context_;
202+
parser::CharBlock source_;
203+
};
204+
144205
// `OmpUnitedTaskDesignatorChecker` is used to check if the designator
145206
// can appear within the TASK construct
146207
class OmpUnitedTaskDesignatorChecker {
@@ -809,6 +870,13 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
809870
"TARGET construct with nested TEAMS region contains statements or "
810871
"directives outside of the TEAMS construct"_err_en_US);
811872
}
873+
if (GetContext().directive == llvm::omp::Directive::OMPD_workdistribute &&
874+
GetContextParent().directive != llvm::omp::Directive::OMPD_teams) {
875+
context_.Say(x.BeginDir().DirName().source,
876+
"%s region can only be strictly nested within the "
877+
"teams region"_err_en_US,
878+
ContextDirectiveAsFortran());
879+
}
812880
}
813881

814882
CheckNoBranching(block, beginSpec.DirId(), beginSpec.source);
@@ -892,6 +960,17 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
892960
HasInvalidWorksharingNesting(
893961
beginSpec.source, llvm::omp::nestedWorkshareErrSet);
894962
break;
963+
case llvm::omp::OMPD_workdistribute:
964+
if (!CurrentDirectiveIsNested()) {
965+
context_.Say(beginSpec.source,
966+
"A workdistribute region must be nested inside teams region only."_err_en_US);
967+
}
968+
CheckWorkdistributeBlockStmts(block, beginSpec.source);
969+
break;
970+
case llvm::omp::OMPD_teams_workdistribute:
971+
case llvm::omp::OMPD_target_teams_workdistribute:
972+
CheckWorkdistributeBlockStmts(block, beginSpec.source);
973+
break;
895974
case llvm::omp::Directive::OMPD_scope:
896975
case llvm::omp::Directive::OMPD_single:
897976
// TODO: This check needs to be extended while implementing nesting of
@@ -4470,6 +4549,22 @@ void OmpStructureChecker::CheckWorkshareBlockStmts(
44704549
}
44714550
}
44724551

4552+
void OmpStructureChecker::CheckWorkdistributeBlockStmts(
4553+
const parser::Block &block, parser::CharBlock source) {
4554+
OmpWorkdistributeBlockChecker ompWorkdistributeBlockChecker{context_, source};
4555+
4556+
for (auto it{block.begin()}; it != block.end(); ++it) {
4557+
if (parser::Unwrap<parser::AssignmentStmt>(*it)) {
4558+
parser::Walk(*it, ompWorkdistributeBlockChecker);
4559+
} else {
4560+
context_.Say(source,
4561+
"The structured block in a WORKDISTRIBUTE construct may consist of "
4562+
"only "
4563+
"SCALAR or ARRAY assignments"_err_en_US);
4564+
}
4565+
}
4566+
}
4567+
44734568
void OmpStructureChecker::CheckIfContiguous(const parser::OmpObject &object) {
44744569
if (auto contig{IsContiguous(context_, object)}; contig && !*contig) {
44754570
const parser::Name *name{GetObjectName(object)};

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -242,6 +242,7 @@ class OmpStructureChecker
242242
llvmOmpClause clause, const parser::OmpObjectList &ompObjectList);
243243
bool CheckTargetBlockOnlyTeams(const parser::Block &);
244244
void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock);
245+
void CheckWorkdistributeBlockStmts(const parser::Block &, parser::CharBlock);
245246

246247
void CheckIteratorRange(const parser::OmpIteratorSpecifier &x);
247248
void CheckIteratorModifier(const parser::OmpIterator &x);

‎flang/test/Lower/OpenMP/workdistribute.f90‎

Lines changed: 7 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -2,12 +2,12 @@
22

33
! CHECK-LABEL: func @_QPtarget_teams_workdistribute
44
subroutine target_teams_workdistribute()
5+
integer :: aa(10), bb(10)
56
! CHECK: omp.target
67
! CHECK: omp.teams
78
! CHECK: omp.workdistribute
89
!$omp target teams workdistribute
9-
! CHECK: fir.call
10-
call f1()
10+
aa = bb
1111
! CHECK: omp.terminator
1212
! CHECK: omp.terminator
1313
! CHECK: omp.terminator
@@ -16,44 +16,15 @@ end subroutine target_teams_workdistribute
1616

1717
! CHECK-LABEL: func @_QPteams_workdistribute
1818
subroutine teams_workdistribute()
19+
use iso_fortran_env
20+
real(kind=real32) :: a
21+
real(kind=real32), dimension(10) :: x
22+
real(kind=real32), dimension(10) :: y
1923
! CHECK: omp.teams
2024
! CHECK: omp.workdistribute
2125
!$omp teams workdistribute
22-
! CHECK: fir.call
23-
call f1()
26+
y = a * x + y
2427
! CHECK: omp.terminator
2528
! CHECK: omp.terminator
2629
!$omp end teams workdistribute
2730
end subroutine teams_workdistribute
28-
29-
! CHECK-LABEL: func @_QPtarget_teams_workdistribute_m
30-
subroutine target_teams_workdistribute_m()
31-
! CHECK: omp.target
32-
! CHECK: omp.teams
33-
! CHECK: omp.workdistribute
34-
!$omp target
35-
!$omp teams
36-
!$omp workdistribute
37-
! CHECK: fir.call
38-
call f1()
39-
! CHECK: omp.terminator
40-
! CHECK: omp.terminator
41-
! CHECK: omp.terminator
42-
!$omp end workdistribute
43-
!$omp end teams
44-
!$omp end target
45-
end subroutine target_teams_workdistribute_m
46-
47-
! CHECK-LABEL: func @_QPteams_workdistribute_m
48-
subroutine teams_workdistribute_m()
49-
! CHECK: omp.teams
50-
! CHECK: omp.workdistribute
51-
!$omp teams
52-
!$omp workdistribute
53-
! CHECK: fir.call
54-
call f1()
55-
! CHECK: omp.terminator
56-
! CHECK: omp.terminator
57-
!$omp end workdistribute
58-
!$omp end teams
59-
end subroutine teams_workdistribute_m

‎flang/test/Semantics/OpenMP/workdistribute01.f90‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
! RUN: %python %S/../test_errors.py %s %flang -fopenmp
2+
! OpenMP Version 6.0
3+
! workdistribute Construct
4+
! Invalid do construct inside !$omp workdistribute
5+
6+
subroutine workdistribute()
7+
integer n, i
8+
!ERROR: A workdistribute region must be nested inside teams region only.
9+
!ERROR: The structured block in a WORKDISTRIBUTE construct may consist of only SCALAR or ARRAY assignments
10+
!$omp workdistribute
11+
do i = 1, n
12+
print *, "omp workdistribute"
13+
end do
14+
!$omp end workdistribute
15+
16+
end subroutine workdistribute

‎flang/test/Semantics/OpenMP/workdistribute02.f90‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
! RUN: %python %S/../test_errors.py %s %flang -fopenmp
2+
! OpenMP Version 6.0
3+
! workdistribute Construct
4+
! The !omp workdistribute construct must not contain any user defined
5+
! function calls unless the function is ELEMENTAL.
6+
7+
module my_mod
8+
contains
9+
integer function my_func()
10+
my_func = 10
11+
end function my_func
12+
13+
impure integer function impure_my_func()
14+
impure_my_func = 20
15+
end function impure_my_func
16+
17+
impure elemental integer function impure_ele_my_func()
18+
impure_ele_my_func = 20
19+
end function impure_ele_my_func
20+
end module my_mod
21+
22+
subroutine workdistribute(aa, bb, cc, n)
23+
use my_mod
24+
integer n
25+
real aa(n), bb(n), cc(n)
26+
!$omp teams
27+
!$omp workdistribute
28+
!ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKDISTRIBUTE construct
29+
aa = my_func()
30+
aa = bb * cc
31+
!$omp end workdistribute
32+
!$omp end teams
33+
34+
end subroutine workdistribute

‎flang/test/Semantics/OpenMP/workdistribute03.f90‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
! RUN: %python %S/../test_errors.py %s %flang -fopenmp
2+
! OpenMP Version 6.0
3+
! workdistribute Construct
4+
! All array assignments, scalar assignments, and masked array assignments
5+
! must be intrinsic assignments.
6+
7+
module defined_assign
8+
interface assignment(=)
9+
module procedure work_assign
10+
end interface
11+
12+
contains
13+
subroutine work_assign(a,b)
14+
integer, intent(out) :: a
15+
logical, intent(in) :: b(:)
16+
end subroutine work_assign
17+
end module defined_assign
18+
19+
program omp_workdistribute
20+
use defined_assign
21+
22+
integer :: a, aa(10), bb(10)
23+
logical :: l(10)
24+
l = .TRUE.
25+
26+
!$omp teams
27+
!$omp workdistribute
28+
!ERROR: Defined assignment statement is not allowed in a WORKDISTRIBUTE construct
29+
a = l
30+
aa = bb
31+
!$omp end workdistribute
32+
!$omp end teams
33+
34+
end program omp_workdistribute

0 commit comments

Comments
 (0)