Skip to content

Commit 6be6081

Browse files
authored
[flang][openacc] Issue an error when TBP are used in data clause (#71444)
Putting a type-bound procedure in a data clause was crashing the lowering. Issue a proper semantic error in this case.
1 parent ecb1fba commit 6be6081

File tree

2 files changed

+44
-0
lines changed

2 files changed

+44
-0
lines changed

flang/lib/Semantics/resolve-directives.cpp

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -280,6 +280,7 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
280280
const parser::Name &, const Symbol &, Symbol::Flag);
281281
void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
282282
void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
283+
void AllowOnlyVariable(const parser::AccObject &object);
283284
void EnsureAllocatableOrPointer(
284285
const llvm::acc::Clause clause, const parser::AccObjectList &objectList);
285286
void AddRoutineInfoToSymbol(
@@ -1117,6 +1118,25 @@ void AccAttributeVisitor::DoNotAllowAssumedSizedArray(
11171118
}
11181119
}
11191120

1121+
void AccAttributeVisitor::AllowOnlyVariable(const parser::AccObject &object) {
1122+
common::visit(
1123+
common::visitors{
1124+
[&](const parser::Designator &designator) {
1125+
const auto &name{GetLastName(designator)};
1126+
if (name.symbol && !semantics::IsVariableName(*name.symbol)) {
1127+
context_.Say(designator.source,
1128+
"Only variables are allowed in data clauses on the %s "
1129+
"directive"_err_en_US,
1130+
parser::ToUpperCaseLetters(
1131+
llvm::acc::getOpenACCDirectiveName(GetContext().directive)
1132+
.str()));
1133+
}
1134+
},
1135+
[&](const auto &name) {},
1136+
},
1137+
object.u);
1138+
}
1139+
11201140
bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
11211141
const auto &verbatim{std::get<parser::Verbatim>(x.t)};
11221142
PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
@@ -1281,6 +1301,7 @@ Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
12811301
void AccAttributeVisitor::ResolveAccObjectList(
12821302
const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
12831303
for (const auto &accObject : accObjectList.v) {
1304+
AllowOnlyVariable(accObject);
12841305
ResolveAccObject(accObject, accFlag);
12851306
}
12861307
}

flang/test/Semantics/OpenACC/acc-data.f90

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -188,3 +188,26 @@ program openacc_data_validity
188188
!$acc end data
189189

190190
end program openacc_data_validity
191+
192+
module mod1
193+
type :: t1
194+
integer :: a
195+
contains
196+
procedure :: t1_proc
197+
end type
198+
199+
contains
200+
201+
202+
subroutine t1_proc(this)
203+
class(t1) :: this
204+
end subroutine
205+
206+
subroutine sub4(t)
207+
type(t1) :: t
208+
209+
!ERROR: Only variables are allowed in data clauses on the DATA directive
210+
!$acc data copy(t%t1_proc)
211+
!$acc end data
212+
end subroutine
213+
end module

0 commit comments

Comments
 (0)