Skip to content

[Flang][OpenMP] Consider renames when processing reduction intrinsics #70822

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jan 19, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions flang/lib/Lower/OpenMP.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -745,6 +745,9 @@ class ReductionProcessor {
const Fortran::parser::ProcedureDesignator &pd) {
const auto *name{Fortran::parser::Unwrap<Fortran::parser::Name>(pd)};
assert(name && "Invalid Reduction Intrinsic.");
if (!name->symbol->GetUltimate().attrs().test(
Fortran::semantics::Attr::INTRINSIC))
return false;
auto redType = llvm::StringSwitch<std::optional<IntrinsicProc>>(
getRealName(name).ToString())
.Case("max", IntrinsicProc::MAX)
Expand Down
20 changes: 11 additions & 9 deletions flang/lib/Semantics/check-omp-structure.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -2299,18 +2299,20 @@ bool OmpStructureChecker::CheckReductionOperators(
},
[&](const parser::ProcedureDesignator &procD) {
const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
if (name) {
if (name->source == "max" || name->source == "min" ||
name->source == "iand" || name->source == "ior" ||
name->source == "ieor") {
if (name && name->symbol) {
const SourceName &realName{name->symbol->GetUltimate().name()};
if (realName == "max" || realName == "min" ||
realName == "iand" || realName == "ior" ||
realName == "ieor") {
ok = true;
} else {
context_.Say(GetContext().clauseSource,
"Invalid reduction identifier in REDUCTION "
"clause."_err_en_US,
ContextDirectiveAsFortran());
}
}
if (!ok) {
context_.Say(GetContext().clauseSource,
"Invalid reduction identifier in REDUCTION "
"clause."_err_en_US,
ContextDirectiveAsFortran());
}
},
},
definedOp.u);
Expand Down
23 changes: 15 additions & 8 deletions flang/lib/Semantics/resolve-directives.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -481,21 +481,28 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
bool Pre(const parser::OmpClause::Reduction &x) {
const parser::OmpReductionOperator &opr{
std::get<parser::OmpReductionOperator>(x.v.t)};
auto createDummyProcSymbol = [&](const parser::Name *name) {
// If name resolution failed, create a dummy symbol
const auto namePair{
currScope().try_emplace(name->source, Attrs{}, ProcEntityDetails{})};
auto &newSymbol{*namePair.first->second};
name->symbol = &newSymbol;
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

nit: either don't create a new variable here, or just leave it as a pointer rather than dereferencing and then referencing it?
E.g.

auto *newSymbol{namePair.first->second};
name->symbol = newSymbol;

I was a little confused by it turning into a reference and then back into a pointer.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The change here is only moving code. We can fix this in a follow-up patch if required.
Also, note that namePair.first->second is of type Fortran::common::Reference<Fortran::semantics::Symbol> and hence the code you provided will not directly work.

};
if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) {
if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
if (!name->symbol) {
const auto namePair{currScope().try_emplace(
name->source, Attrs{}, ProcEntityDetails{})};
auto &symbol{*namePair.first->second};
name->symbol = &symbol;
name->symbol->set(Symbol::Flag::OmpReduction);
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should the new symbol above also be set as an OmpReduction symbol? It doesn't look like this is getting set anymore

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is currently only used for the variable that is present in the reduction clause and not for the function/operation. For supporting user-defined reductions, this might be needed in future, but at the moment there is no use either in semantics or lowering.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nit: would it be worth adding the OmpReduction flag on it anyway, since it is a reduction variable and we might need it later? Just so we aren't confused later. It does look like it was getting set before this change?

AddToContextObjectWithDSA(*name->symbol, Symbol::Flag::OmpReduction);
if (!ResolveName(name)) {
createDummyProcSymbol(name);
}
}
}
if (const auto *procRef{
parser::Unwrap<parser::ProcComponentRef>(procD->u)}) {
ResolveOmp(*procRef->v.thing.component.symbol,
Symbol::Flag::OmpReduction, currScope());
if (!procRef->v.thing.component.symbol) {
if (!ResolveName(&procRef->v.thing.component)) {
createDummyProcSymbol(&procRef->v.thing.component);
}
}
}
}
const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
Expand Down
19 changes: 19 additions & 0 deletions flang/test/Lower/OpenMP/wsloop-reduction-max-2.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
! RUN: bbc -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s

! CHECK: omp.wsloop reduction(@max_i_32
! CHECK: omp.reduction

module m1
intrinsic max
end module m1
program main
use m1, ren=>max
n=0
!$omp parallel do reduction(ren:n)
do i=1,100
n=max(n,i)
end do
if (n/=100) print *,101
print *,'pass'
end program main