[flang-commits] [flang] [flang] Add parsing of DO CONCURRENT REDUCE clause (PR #92518)
via flang-commits
flang-commits at lists.llvm.org
Mon May 20 12:49:02 PDT 2024
https://github.com/khaki3 updated https://github.com/llvm/llvm-project/pull/92518
>From 6116f8ac841eec714903379615f21b656655c293 Mon Sep 17 00:00:00 2001
From: Kazuaki Matsumura <kmatsumura at nvidia.com>
Date: Fri, 17 May 2024 03:41:29 -0700
Subject: [PATCH 1/4] [flang] Add parsing of DO CONCURRENT REDUCE clause
---
flang/examples/FeatureList/FeatureList.cpp | 2 +
flang/include/flang/Parser/dump-parse-tree.h | 2 +
flang/include/flang/Parser/parse-tree.h | 29 ++++--
flang/include/flang/Semantics/symbol.h | 1 +
flang/lib/Parser/executable-parsers.cpp | 10 ++
flang/lib/Parser/unparse.cpp | 4 +
flang/lib/Semantics/check-do-forall.cpp | 89 ++++++++++++++++
flang/lib/Semantics/resolve-names.cpp | 103 +++++++++++++------
flang/test/Semantics/resolve123.f90 | 79 ++++++++++++++
flang/test/Semantics/resolve124.f90 | 89 ++++++++++++++++
flang/test/Semantics/resolve55.f90 | 19 ++--
11 files changed, 382 insertions(+), 45 deletions(-)
create mode 100644 flang/test/Semantics/resolve123.f90
create mode 100644 flang/test/Semantics/resolve124.f90
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 3ca92da4f6467..28689b5d3c4b0 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/flang/examples/FeatureList/FeatureList.cpp
@@ -410,10 +410,12 @@ struct NodeVisitor {
READ_FEATURE(LetterSpec)
READ_FEATURE(LiteralConstant)
READ_FEATURE(IntLiteralConstant)
+ READ_FEATURE(ReduceOperation)
READ_FEATURE(LocalitySpec)
READ_FEATURE(LocalitySpec::DefaultNone)
READ_FEATURE(LocalitySpec::Local)
READ_FEATURE(LocalitySpec::LocalInit)
+ READ_FEATURE(LocalitySpec::Reduce)
READ_FEATURE(LocalitySpec::Shared)
READ_FEATURE(LockStmt)
READ_FEATURE(LockStmt::LockStat)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 68ae50c312cde..15948bb073664 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -436,10 +436,12 @@ class ParseTreeDumper {
NODE(parser, LetterSpec)
NODE(parser, LiteralConstant)
NODE(parser, IntLiteralConstant)
+ NODE(parser, ReduceOperation)
NODE(parser, LocalitySpec)
NODE(LocalitySpec, DefaultNone)
NODE(LocalitySpec, Local)
NODE(LocalitySpec, LocalInit)
+ NODE(LocalitySpec, Reduce)
NODE(LocalitySpec, Shared)
NODE(parser, LockStmt)
NODE(LockStmt, LockStat)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 0a40aa8b8f616..68a4319a85047 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1870,6 +1870,13 @@ struct ProcComponentRef {
WRAPPER_CLASS_BOILERPLATE(ProcComponentRef, Scalar<StructureComponent>);
};
+// R1522 procedure-designator ->
+// procedure-name | proc-component-ref | data-ref % binding-name
+struct ProcedureDesignator {
+ UNION_CLASS_BOILERPLATE(ProcedureDesignator);
+ std::variant<Name, ProcComponentRef> u;
+};
+
// R914 coindexed-named-object -> data-ref
struct CoindexedNamedObject {
BOILERPLATE(CoindexedNamedObject);
@@ -2236,16 +2243,29 @@ struct ConcurrentHeader {
t;
};
+// F'2023 R1131 reduce-operation ->
+// + | * | .AND. | .OR. | .EQV. | .NEQV. |
+// MAX | MIN | IAND | IOR | IEOR
+struct ReduceOperation {
+ UNION_CLASS_BOILERPLATE(ReduceOperation);
+ std::variant<DefinedOperator, ProcedureDesignator> u;
+};
+
// R1130 locality-spec ->
// LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
+// REDUCE ( reduce-operation : variable-name-list ) |
// SHARED ( variable-name-list ) | DEFAULT ( NONE )
struct LocalitySpec {
UNION_CLASS_BOILERPLATE(LocalitySpec);
WRAPPER_CLASS(Local, std::list<Name>);
WRAPPER_CLASS(LocalInit, std::list<Name>);
+ struct Reduce {
+ TUPLE_CLASS_BOILERPLATE(Reduce);
+ std::tuple<ReduceOperation, std::list<Name>> t;
+ };
WRAPPER_CLASS(Shared, std::list<Name>);
EMPTY_CLASS(DefaultNone);
- std::variant<Local, LocalInit, Shared, DefaultNone> u;
+ std::variant<Local, LocalInit, Reduce, Shared, DefaultNone> u;
};
// R1123 loop-control ->
@@ -3180,13 +3200,6 @@ WRAPPER_CLASS(ExternalStmt, std::list<Name>);
// R1519 intrinsic-stmt -> INTRINSIC [::] intrinsic-procedure-name-list
WRAPPER_CLASS(IntrinsicStmt, std::list<Name>);
-// R1522 procedure-designator ->
-// procedure-name | proc-component-ref | data-ref % binding-name
-struct ProcedureDesignator {
- UNION_CLASS_BOILERPLATE(ProcedureDesignator);
- std::variant<Name, ProcComponentRef> u;
-};
-
// R1525 alt-return-spec -> * label
WRAPPER_CLASS(AltReturnSpec, Label);
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 50f7b68d80cb1..8ccf93c803845 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -714,6 +714,7 @@ class Symbol {
CrayPointer, CrayPointee,
LocalityLocal, // named in LOCAL locality-spec
LocalityLocalInit, // named in LOCAL_INIT locality-spec
+ LocalityReduce, // named in REDUCE locality-spec
LocalityShared, // named in SHARED locality-spec
InDataStmt, // initialized in a DATA statement, =>object, or /init/
InNamelist, // in a Namelist group
diff --git a/flang/lib/Parser/executable-parsers.cpp b/flang/lib/Parser/executable-parsers.cpp
index 382a593416872..6bacdb34f8c70 100644
--- a/flang/lib/Parser/executable-parsers.cpp
+++ b/flang/lib/Parser/executable-parsers.cpp
@@ -252,13 +252,23 @@ TYPE_PARSER(parenthesized(construct<ConcurrentHeader>(
TYPE_PARSER(construct<ConcurrentControl>(name / "=", scalarIntExpr / ":",
scalarIntExpr, maybe(":" >> scalarIntExpr)))
+// F'2023 R1131 reduce-operation ->
+// + | * | .AND. | .OR. | .EQV. | .NEQV. |
+// MAX | MIN | IAND | IOR | IEOR
+TYPE_PARSER(construct<ReduceOperation>(Parser<DefinedOperator>{}) ||
+ construct<ReduceOperation>(Parser<ProcedureDesignator>{}))
+
// R1130 locality-spec ->
// LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
+// REDUCE ( reduce-operation : variable-name-list ) |
// SHARED ( variable-name-list ) | DEFAULT ( NONE )
TYPE_PARSER(construct<LocalitySpec>(construct<LocalitySpec::Local>(
"LOCAL" >> parenthesized(listOfNames))) ||
construct<LocalitySpec>(construct<LocalitySpec::LocalInit>(
"LOCAL_INIT"_sptok >> parenthesized(listOfNames))) ||
+ construct<LocalitySpec>(construct<LocalitySpec::Reduce>(
+ "REDUCE"_sptok >> "("_tok >> Parser<ReduceOperation>{} / ":",
+ listOfNames / ")")) ||
construct<LocalitySpec>(construct<LocalitySpec::Shared>(
"SHARED" >> parenthesized(listOfNames))) ||
construct<LocalitySpec>(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 1639e900903fe..969b9c3a3802b 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1038,6 +1038,10 @@ class UnparseVisitor {
void Unparse(const LocalitySpec::LocalInit &x) {
Word("LOCAL_INIT("), Walk(x.v, ", "), Put(')');
}
+ void Unparse(const LocalitySpec::Reduce &x) {
+ Word("REDUCE("), Walk(std::get<parser::ReduceOperation>(x.t)), Put(':');
+ Walk(std::get<std::list<parser::Name>>(x.t), ", "), Put(')');
+ }
void Unparse(const LocalitySpec::Shared &x) {
Word("SHARED("), Walk(x.v, ", "), Put(')');
}
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index c1eab090a4bb1..450a6ccda172b 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -683,6 +683,89 @@ class DoContext {
}
}
+ void CheckReduce(
+ const parser::LocalitySpec::Reduce &reduce) const {
+ const parser::ReduceOperation &reduceOperation =
+ std::get<parser::ReduceOperation>(reduce.t);
+ // F'2023 C1132, reduction variables should have suitable intrinsic type
+ bool supported_identifier = true;
+ common::visit(
+ common::visitors{
+ [&](const parser::DefinedOperator &dOpr) {
+ const auto &intrinsicOp{
+ std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)
+ };
+ for (const Fortran::parser::Name &x :
+ std::get<std::list<Fortran::parser::Name>>(reduce.t)) {
+ const auto *type{x.symbol->GetType()};
+ bool suitable_type = false;
+ switch (intrinsicOp) {
+ case parser::DefinedOperator::IntrinsicOperator::Add:
+ case parser::DefinedOperator::IntrinsicOperator::Multiply:
+ if (type->IsNumeric(TypeCategory::Integer) ||
+ type->IsNumeric(TypeCategory::Real) ||
+ type->IsNumeric(TypeCategory::Complex)) {
+ // TODO: check composite type.
+ suitable_type = true;
+ }
+ break;
+ case parser::DefinedOperator::IntrinsicOperator::AND:
+ case parser::DefinedOperator::IntrinsicOperator::OR:
+ case parser::DefinedOperator::IntrinsicOperator::EQV:
+ case parser::DefinedOperator::IntrinsicOperator::NEQV:
+ if (type->category() == DeclTypeSpec::Category::Logical) {
+ suitable_type = true;
+ }
+ break;
+ default:
+ supported_identifier = false;
+ return;
+ }
+ if (!suitable_type) {
+ context_.Say(currentStatementSourcePosition_,
+ "Reduction variable '%s' does not have a "
+ "suitable type."_err_en_US, x.symbol->name());
+ }
+ }
+ },
+ [&](const parser::ProcedureDesignator &procD) {
+ const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
+ if (!(name && name->symbol)) {
+ supported_identifier = false;
+ return;
+ }
+ const SourceName &realName{name->symbol->GetUltimate().name()};
+ for (const Fortran::parser::Name &x : std::get<std::list<
+ Fortran::parser::Name>>(reduce.t)) {
+ const auto *type{x.symbol->GetType()};
+ bool suitable_type = false;
+ if (realName == "max" || realName == "min") {
+ if (type->IsNumeric(TypeCategory::Integer) ||
+ type->IsNumeric(TypeCategory::Real))
+ suitable_type = true;
+ } else if (realName == "iand" || realName == "ior" ||
+ realName == "ieor") {
+ if (type->IsNumeric(TypeCategory::Integer))
+ suitable_type = true;
+ } else {
+ supported_identifier = false;
+ return;
+ }
+ if (!suitable_type) {
+ context_.Say(currentStatementSourcePosition_,
+ "Reduction variable '%s' does not have a "
+ "suitable type."_err_en_US, x.symbol->name());
+ }
+ }
+ }
+ },
+ reduceOperation.u);
+ if (!supported_identifier) {
+ context_.Say(currentStatementSourcePosition_,
+ "Invalid reduction identifier in REDUCE clause."_err_en_US);
+ }
+ }
+
// C1123, concurrent limit or step expressions can't reference index-names
void CheckConcurrentHeader(const parser::ConcurrentHeader &header) const {
if (const auto &mask{
@@ -737,6 +820,12 @@ class DoContext {
std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {
CheckMaskDoesNotReferenceLocal(*mask, localVars);
}
+ for (auto &ls : localitySpecs) {
+ if (const auto *reduce{
+ std::get_if<parser::LocalitySpec::Reduce>(&ls.u)}) {
+ CheckReduce(*reduce);
+ }
+ }
CheckDefaultNoneImpliesExplicitLocality(localitySpecs, block);
}
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 40eee89de131a..61f0811982feb 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -537,7 +537,9 @@ class ScopeHandler : public ImplicitRulesVisitor {
void SayAlreadyDeclared(const SourceName &, const SourceName &);
void SayWithReason(
const parser::Name &, Symbol &, MessageFixedText &&, Message &&);
- void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
+ template <typename... A>
+ void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&,
+ A &&...args);
void SayLocalMustBeVariable(const parser::Name &, Symbol &);
void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
@@ -1041,10 +1043,10 @@ class DeclarationVisitor : public ArraySpecVisitor,
Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
// Make sure that there's an entity in an enclosing scope called Name
Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
- // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
+ // Declare a LOCAL/LOCAL_INIT/REDUCE entity. If there isn't a type specified
// it comes from the entity in the containing scope, or implicit rules.
// Return pointer to the new symbol, or nullptr on error.
- Symbol *DeclareLocalEntity(const parser::Name &);
+ Symbol *DeclareLocalEntity(const parser::Name &, Symbol::Flag);
// Declare a statement entity (i.e., an implied DO loop index for
// a DATA statement or an array constructor). If there isn't an explict
// type specified, implicit rules apply. Return pointer to the new symbol,
@@ -1145,7 +1147,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
void Initialization(const parser::Name &, const parser::Initialization &,
bool inComponentDecl);
- bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
+ bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol,
+ Symbol::Flag flag);
bool CheckForHostAssociatedImplicit(const parser::Name &);
// Declare an object or procedure entity.
@@ -1214,6 +1217,7 @@ class ConstructVisitor : public virtual DeclarationVisitor {
bool Pre(const parser::ConcurrentHeader &);
bool Pre(const parser::LocalitySpec::Local &);
bool Pre(const parser::LocalitySpec::LocalInit &);
+ bool Pre(const parser::LocalitySpec::Reduce &);
bool Pre(const parser::LocalitySpec::Shared &);
bool Pre(const parser::AcSpec &);
bool Pre(const parser::AcImpliedDo &);
@@ -1573,6 +1577,7 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
ResolveName(*parser::Unwrap<parser::Name>(x.name));
}
void Post(const parser::ProcComponentRef &);
+ bool Pre(const parser::ReduceOperation &);
bool Pre(const parser::FunctionReference &);
bool Pre(const parser::CallStmt &);
bool Pre(const parser::ImportStmt &);
@@ -2254,9 +2259,11 @@ void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
context().SetError(symbol, isFatal);
}
-void ScopeHandler::SayWithDecl(
- const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
- auto &message{Say(name, std::move(msg), symbol.name())
+template <typename... A> void ScopeHandler::SayWithDecl(
+ const parser::Name &name, Symbol &symbol, MessageFixedText &&msg,
+ A &&...args) {
+ auto &message{Say(name.source, std::move(msg), symbol.name(),
+ std::forward<A>(args)...)
.Attach(Message{symbol.name(),
symbol.test(Symbol::Flag::Implicit)
? "Implicit declaration of '%s'"_en_US
@@ -6458,44 +6465,60 @@ bool DeclarationVisitor::PassesSharedLocalityChecks(
return true;
}
-// Checks for locality-specs LOCAL and LOCAL_INIT
+// Checks for locality-specs LOCAL, LOCAL_INIT, and REDUCE
bool DeclarationVisitor::PassesLocalityChecks(
- const parser::Name &name, Symbol &symbol) {
- if (IsAllocatable(symbol)) { // C1128
- SayWithDecl(name, symbol,
- "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US);
+ const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
+ bool isReduce = flag == Symbol::Flag::LocalityReduce;
+ if (IsAllocatable(symbol) && !isReduce) { // C1128, F'2023 C1130
+ SayWithDecl(name, symbol, "ALLOCATABLE variable '%s' not allowed in a "
+ "LOCAL%s locality-spec"_err_en_US,
+ (flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
}
- if (IsOptional(symbol)) { // C1128
+ if (IsOptional(symbol)) { // C1128, F'2023 C1130-C1131
SayWithDecl(name, symbol,
"OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
return false;
}
- if (IsIntentIn(symbol)) { // C1128
+ if (IsIntentIn(symbol)) { // C1128, F'2023 C1130-C1131
SayWithDecl(name, symbol,
"INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
return false;
}
- if (IsFinalizable(symbol)) { // C1128
- SayWithDecl(name, symbol,
- "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US);
+ if (IsFinalizable(symbol) && !isReduce) { // C1128, F'2023 C1130
+ SayWithDecl(name, symbol, "Finalizable variable '%s' not allowed in a "
+ "LOCAL%s locality-spec"_err_en_US,
+ (flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
}
- if (evaluate::IsCoarray(symbol)) { // C1128
- SayWithDecl(
- name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US);
+ if (evaluate::IsCoarray(symbol) && !isReduce) { // C1128, F'2023 C1130
+ SayWithDecl(name, symbol, "Coarray '%s' not allowed in a "
+ "LOCAL%s locality-spec"_err_en_US,
+ (flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
}
if (const DeclTypeSpec * type{symbol.GetType()}) {
if (type->IsPolymorphic() && IsDummy(symbol) &&
- !IsPointer(symbol)) { // C1128
- SayWithDecl(name, symbol,
- "Nonpointer polymorphic argument '%s' not allowed in a "
- "locality-spec"_err_en_US);
+ !IsPointer(symbol) && !isReduce) { // C1128, F'2023 C1130
+ SayWithDecl(name, symbol, "Nonpointer polymorphic argument '%s' not "
+ "allowed in a LOCAL%s locality-spec"_err_en_US,
+ (flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
}
}
- if (IsAssumedSizeArray(symbol)) { // C1128
+ if (symbol.attrs().test(Attr::ASYNCHRONOUS) && isReduce) { // F'2023 C1131
+ SayWithDecl(name, symbol,
+ "ASYNCHRONOUS variable '%s' not allowed in a "
+ "REDUCE locality-spec"_err_en_US);
+ return false;
+ }
+ if (symbol.attrs().test(Attr::VOLATILE) && isReduce) { // F'2023 C1131
+ SayWithDecl(name, symbol,
+ "VOLATILE variable '%s' not allowed in a "
+ "REDUCE locality-spec"_err_en_US);
+ return false;
+ }
+ if (IsAssumedSizeArray(symbol)) { // C1128, F'2023 C1130-C1131
SayWithDecl(name, symbol,
"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
return false;
@@ -6524,9 +6547,10 @@ Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
return *prev;
}
-Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
+Symbol *DeclarationVisitor::DeclareLocalEntity(
+ const parser::Name &name, Symbol::Flag flag) {
Symbol &prev{FindOrDeclareEnclosingEntity(name)};
- if (!PassesLocalityChecks(name, prev)) {
+ if (!PassesLocalityChecks(name, prev, flag)) {
return nullptr;
}
return &MakeHostAssocSymbol(name, prev);
@@ -6866,7 +6890,7 @@ bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
for (auto &name : x.v) {
- if (auto *symbol{DeclareLocalEntity(name)}) {
+ if (auto *symbol{DeclareLocalEntity(name, Symbol::Flag::LocalityLocal)}) {
symbol->set(Symbol::Flag::LocalityLocal);
}
}
@@ -6875,13 +6899,25 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
for (auto &name : x.v) {
- if (auto *symbol{DeclareLocalEntity(name)}) {
+ if (auto *symbol{
+ DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit)}) {
symbol->set(Symbol::Flag::LocalityLocalInit);
}
}
return false;
}
+bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {
+ Walk(std::get<parser::ReduceOperation>(x.t));
+ for (auto &name : std::get<std::list<parser::Name>>(x.t)) {
+ if (auto *symbol{
+ DeclareLocalEntity(name, Symbol::Flag::LocalityReduce)}) {
+ symbol->set(Symbol::Flag::LocalityReduce);
+ }
+ }
+ return false;
+}
+
bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
for (const auto &name : x.v) {
if (!FindSymbol(name)) {
@@ -8216,6 +8252,15 @@ void ResolveNamesVisitor::HandleProcedureName(
}
}
+bool ResolveNamesVisitor::Pre(const parser::ReduceOperation &x) {
+ if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(x.u)}) {
+ if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
+ HandleProcedureName(Symbol::Flag::Function, *name);
+ }
+ }
+ return false;
+}
+
bool ResolveNamesVisitor::CheckImplicitNoneExternal(
const SourceName &name, const Symbol &symbol) {
if (symbol.has<ProcEntityDetails>() && isImplicitNoneExternal() &&
diff --git a/flang/test/Semantics/resolve123.f90 b/flang/test/Semantics/resolve123.f90
new file mode 100644
index 0000000000000..1b2c4613f2fef
--- /dev/null
+++ b/flang/test/Semantics/resolve123.f90
@@ -0,0 +1,79 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests for F'2023 C1131:
+! A variable-name that appears in a REDUCE locality-spec shall not have the
+! ASYNCHRONOUS, INTENT (IN), OPTIONAL, or VOLATILE attribute, shall not be
+! coindexed, and shall not be an assumed-size array. A variable-name that is not
+! permitted to appear in a variable definition context shall not appear in a
+! REDUCE locality-spec.
+
+subroutine s1()
+! Cannot have ASYNCHRONOUS variable in a REDUCE locality spec
+ integer, asynchronous :: k
+!ERROR: ASYNCHRONOUS variable 'k' not allowed in a REDUCE locality-spec
+ do concurrent(i=1:5) reduce(+:k)
+ k = k + i
+ end do
+end subroutine s1
+
+subroutine s2(arg)
+! Cannot have a dummy OPTIONAL in a REDUCE locality spec
+ integer, optional :: arg
+!ERROR: OPTIONAL argument 'arg' not allowed in a locality-spec
+ do concurrent(i=1:5) reduce(*:arg)
+ arg = arg * 1
+ end do
+end subroutine s2
+
+subroutine s3(arg)
+! This is OK
+ real :: arg
+ integer :: reduce, reduce2, reduce3
+ do concurrent(i=1:5) reduce(max:arg,reduce) reduce(iand:reduce2,reduce3)
+ arg = max(arg, i)
+ reduce = max(reduce, i)
+ reduce3 = iand(reduce3, i)
+ end do
+end subroutine s3
+
+subroutine s4(arg)
+! Cannot have a dummy INTENT(IN) in a REDUCE locality spec
+ real, intent(in) :: arg
+!ERROR: INTENT IN argument 'arg' not allowed in a locality-spec
+ do concurrent(i=1:5) reduce(min:arg)
+!ERROR: Left-hand side of assignment is not definable
+!ERROR: 'arg' is an INTENT(IN) dummy argument
+ arg = min(arg, i)
+ end do
+end subroutine s4
+
+module m
+contains
+ subroutine s5()
+ ! Cannot have VOLATILE variable in a REDUCE locality spec
+ integer, volatile :: var
+ !ERROR: VOLATILE variable 'var' not allowed in a REDUCE locality-spec
+ do concurrent(i=1:5) reduce(ieor:var)
+ var = ieor(var, i)
+ end do
+ end subroutine s5
+ subroutine f(x)
+ integer :: x
+ end subroutine f
+end module m
+
+subroutine s8(arg)
+! Cannot have an assumed size array
+ integer, dimension(*) :: arg
+!ERROR: Assumed size array 'arg' not allowed in a locality-spec
+ do concurrent(i=1:5) reduce(ior:arg)
+ arg(i) = ior(arg(i), i)
+ end do
+end subroutine s8
+
+subroutine s9()
+! Reduction variable should not appear in a variable definition context
+ integer :: i
+!ERROR: 'i' is already declared in this scoping unit
+ do concurrent(i=1:5) reduce(+:i)
+ end do
+end subroutine s9
diff --git a/flang/test/Semantics/resolve124.f90 b/flang/test/Semantics/resolve124.f90
new file mode 100644
index 0000000000000..efb920c6f5d7f
--- /dev/null
+++ b/flang/test/Semantics/resolve124.f90
@@ -0,0 +1,89 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests for F'2023 C1132:
+! A variable-name that appears in a REDUCE locality-spec shall be of intrinsic
+! type suitable for the intrinsic operation or function specified by its
+! reduce-operation.
+
+subroutine s1(n)
+! This is OK
+ integer :: i1, i2, i3, i4, i5, i6, i7, n
+ real(8) :: r1, r2, r3, r4
+ complex :: c1, c2
+ logical :: l1, l2, l3(n,n), l4(n)
+ do concurrent(i=1:5) &
+ & reduce(+:i1,r1,c1) reduce(*:i2,r2,c2) reduce(iand:i3) reduce(ieor:i4) &
+ & reduce(ior:i5) reduce(max:i6,r3) reduce(min:i7,r4) reduce(.and.:l1) &
+ & reduce(.or.:l2) reduce(.eqv.:l3) reduce(.neqv.:l4)
+ end do
+end subroutine s1
+
+subroutine s2()
+! Cannot apply logical operations to integer variables
+ integer :: i1, i2, i3, i4
+!ERROR: Reduction variable 'i1' does not have a suitable type.
+!ERROR: Reduction variable 'i2' does not have a suitable type.
+!ERROR: Reduction variable 'i3' does not have a suitable type.
+!ERROR: Reduction variable 'i4' does not have a suitable type.
+ do concurrent(i=1:5) &
+ & reduce(.and.:i1) reduce(.or.:i2) reduce(.eqv.:i3) reduce(.neqv.:i4)
+ end do
+end subroutine s2
+
+subroutine s3()
+! Cannot apply integer/logical operations to real variables
+ real :: r1, r2, r3, r4
+!ERROR: Reduction variable 'r1' does not have a suitable type.
+!ERROR: Reduction variable 'r2' does not have a suitable type.
+!ERROR: Reduction variable 'r3' does not have a suitable type.
+!ERROR: Reduction variable 'r4' does not have a suitable type.
+!ERROR: Reduction variable 'r5' does not have a suitable type.
+!ERROR: Reduction variable 'r6' does not have a suitable type.
+!ERROR: Reduction variable 'r7' does not have a suitable type.
+ do concurrent(i=1:5) &
+ & reduce(iand:r1) reduce(ieor:r2) reduce(ior:r3) reduce(.and.:r4) &
+ & reduce(.or.:r5) reduce(.eqv.:r6) reduce(.neqv.:r7)
+ end do
+end subroutine s3
+
+subroutine s4()
+! Cannot apply integer/logical operations to complex variables
+ complex :: c1, c2, c3, c4, c5, c6, c7, c8, c9
+!ERROR: Reduction variable 'c1' does not have a suitable type.
+!ERROR: Reduction variable 'c2' does not have a suitable type.
+!ERROR: Reduction variable 'c3' does not have a suitable type.
+!ERROR: Reduction variable 'c4' does not have a suitable type.
+!ERROR: Reduction variable 'c5' does not have a suitable type.
+!ERROR: Reduction variable 'c6' does not have a suitable type.
+!ERROR: Reduction variable 'c7' does not have a suitable type.
+!ERROR: Reduction variable 'c8' does not have a suitable type.
+!ERROR: Reduction variable 'c9' does not have a suitable type.
+ do concurrent(i=1:5) &
+ & reduce(iand:c1) reduce(ieor:c2) reduce(ior:c3) reduce(max:c4) &
+ & reduce(min:c5) reduce(.and.:c6) reduce(.or.:c7) reduce(.eqv.:c8) &
+ & reduce(.neqv.:c9)
+ end do
+end subroutine s4
+
+subroutine s5()
+! Cannot apply integer operations to logical variables
+ logical :: l1, l2, l3, l4, l5, l6, l7
+!ERROR: Reduction variable 'l1' does not have a suitable type.
+!ERROR: Reduction variable 'l2' does not have a suitable type.
+!ERROR: Reduction variable 'l3' does not have a suitable type.
+!ERROR: Reduction variable 'l4' does not have a suitable type.
+!ERROR: Reduction variable 'l5' does not have a suitable type.
+!ERROR: Reduction variable 'l6' does not have a suitable type.
+!ERROR: Reduction variable 'l7' does not have a suitable type.
+ do concurrent(i=1:5) &
+ & reduce(+:l1) reduce(*:l2) reduce(iand:l3) reduce(ieor:l4) &
+ & reduce(ior:l5) reduce(max:l6) reduce(min:l7)
+ end do
+end subroutine s5
+
+subroutine s6()
+! Cannot reduce a character
+ character ch
+!ERROR: Reduction variable 'ch' does not have a suitable type.
+ do concurrent(i=1:5) reduce(+:ch)
+ end do
+end subroutine s6
diff --git a/flang/test/Semantics/resolve55.f90 b/flang/test/Semantics/resolve55.f90
index 1133e791fa389..54ecb341a82e4 100644
--- a/flang/test/Semantics/resolve55.f90
+++ b/flang/test/Semantics/resolve55.f90
@@ -1,16 +1,19 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! Tests for C1128:
+! Tests for C1128 and F'2023 C1130:
! A variable-name that appears in a LOCAL or LOCAL_INIT locality-spec shall not
! have the ALLOCATABLE; INTENT (IN); or OPTIONAL attribute; shall not be of
! finalizable type; shall not be a nonpointer polymorphic dummy argument; and
! shall not be a coarray or an assumed-size array.
subroutine s1()
-! Cannot have ALLOCATABLE variable in a locality spec
+! Cannot have ALLOCATABLE variable in a LOCAL/LOCAL_INIT locality spec
integer, allocatable :: k
-!ERROR: ALLOCATABLE variable 'k' not allowed in a locality-spec
+!ERROR: ALLOCATABLE variable 'k' not allowed in a LOCAL locality-spec
do concurrent(i=1:5) local(k)
end do
+!ERROR: ALLOCATABLE variable 'k' not allowed in a LOCAL_INIT locality-spec
+ do concurrent(i=1:5) local_init(k)
+ end do
end subroutine s1
subroutine s2(arg)
@@ -37,7 +40,7 @@ subroutine s4(arg)
end subroutine s4
module m
-! Cannot have a variable of a finalizable type in a locality spec
+! Cannot have a variable of a finalizable type in a LOCAL locality spec
type t1
integer :: i
contains
@@ -46,7 +49,7 @@ module m
contains
subroutine s5()
type(t1) :: var
- !ERROR: Finalizable variable 'var' not allowed in a locality-spec
+ !ERROR: Finalizable variable 'var' not allowed in a LOCAL locality-spec
do concurrent(i=1:5) local(var)
end do
end subroutine s5
@@ -56,7 +59,7 @@ end subroutine f
end module m
subroutine s6
-! Cannot have a nonpointer polymorphic dummy argument in a locality spec
+! Cannot have a nonpointer polymorphic dummy argument in a LOCAL locality spec
type :: t
integer :: field
end type t
@@ -70,7 +73,7 @@ subroutine s(x, y)
end do
! This is not allowed
-!ERROR: Nonpointer polymorphic argument 'y' not allowed in a locality-spec
+!ERROR: Nonpointer polymorphic argument 'y' not allowed in a LOCAL locality-spec
do concurrent(i=1:5) local(y)
end do
end subroutine s
@@ -79,7 +82,7 @@ end subroutine s6
subroutine s7()
! Cannot have a coarray
integer, codimension[*] :: coarray_var
-!ERROR: Coarray 'coarray_var' not allowed in a locality-spec
+!ERROR: Coarray 'coarray_var' not allowed in a LOCAL locality-spec
do concurrent(i=1:5) local(coarray_var)
end do
end subroutine s7
>From 86a29a20ee0dfb40bfcf678ea0cc5a52ac66345c Mon Sep 17 00:00:00 2001
From: Kazuaki Matsumura <kmatsumura at nvidia.com>
Date: Mon, 20 May 2024 12:21:42 -0700
Subject: [PATCH 2/4] [flang] Rename AccReductionOperator to ReductionOperator
for the reuse in DO CONCURRENT REDUCE parsing
---
flang/examples/FeatureList/FeatureList.cpp | 5 +-
flang/include/flang/Parser/dump-parse-tree.h | 5 +-
flang/include/flang/Parser/parse-tree.h | 30 ++--
flang/lib/Lower/OpenACC.cpp | 26 ++--
flang/lib/Parser/executable-parsers.cpp | 8 +-
flang/lib/Parser/openacc-parsers.cpp | 26 ++--
flang/lib/Parser/unparse.cpp | 22 +--
flang/lib/Semantics/check-acc-structure.cpp | 40 +++---
flang/lib/Semantics/check-cuda.cpp | 22 +--
flang/lib/Semantics/check-do-forall.cpp | 137 ++++++++-----------
flang/lib/Semantics/resolve-names.cpp | 137 +++++++++----------
flang/test/Semantics/resolve124.f90 | 56 ++++----
12 files changed, 230 insertions(+), 284 deletions(-)
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 28689b5d3c4b0..8fd0236608a66 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/flang/examples/FeatureList/FeatureList.cpp
@@ -86,8 +86,6 @@ struct NodeVisitor {
READ_FEATURE(AccObjectList)
READ_FEATURE(AccObjectListWithModifier)
READ_FEATURE(AccObjectListWithReduction)
- READ_FEATURE(AccReductionOperator)
- READ_FEATURE(AccReductionOperator::Operator)
READ_FEATURE(AccSizeExpr)
READ_FEATURE(AccSizeExprList)
READ_FEATURE(AccSelfClause)
@@ -410,7 +408,8 @@ struct NodeVisitor {
READ_FEATURE(LetterSpec)
READ_FEATURE(LiteralConstant)
READ_FEATURE(IntLiteralConstant)
- READ_FEATURE(ReduceOperation)
+ READ_FEATURE(ReductionOperator)
+ READ_FEATURE(ReductionOperator::Operator)
READ_FEATURE(LocalitySpec)
READ_FEATURE(LocalitySpec::DefaultNone)
READ_FEATURE(LocalitySpec::Local)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 15948bb073664..4232e85a6e595 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -95,8 +95,6 @@ class ParseTreeDumper {
NODE(parser, AccObjectList)
NODE(parser, AccObjectListWithModifier)
NODE(parser, AccObjectListWithReduction)
- NODE(parser, AccReductionOperator)
- NODE_ENUM(parser::AccReductionOperator, Operator)
NODE(parser, AccSizeExpr)
NODE(parser, AccSizeExprList)
NODE(parser, AccSelfClause)
@@ -436,7 +434,8 @@ class ParseTreeDumper {
NODE(parser, LetterSpec)
NODE(parser, LiteralConstant)
NODE(parser, IntLiteralConstant)
- NODE(parser, ReduceOperation)
+ NODE(parser, ReductionOperator)
+ NODE_ENUM(parser::ReductionOperator, Operator)
NODE(parser, LocalitySpec)
NODE(LocalitySpec, DefaultNone)
NODE(LocalitySpec, Local)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 68a4319a85047..fd60f99bac1f6 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -2243,17 +2243,18 @@ struct ConcurrentHeader {
t;
};
-// F'2023 R1131 reduce-operation ->
-// + | * | .AND. | .OR. | .EQV. | .NEQV. |
-// MAX | MIN | IAND | IOR | IEOR
-struct ReduceOperation {
- UNION_CLASS_BOILERPLATE(ReduceOperation);
- std::variant<DefinedOperator, ProcedureDesignator> u;
+// OpenACC 3.2
+// 2.5.15: + | * | max | min | iand | ior | ieor | .and. | .or. | .eqv. | .neqv.
+struct ReductionOperator {
+ ENUM_CLASS(
+ Operator, Plus, Multiply, Max, Min, Iand, Ior, Ieor, And, Or, Eqv, Neqv)
+ WRAPPER_CLASS_BOILERPLATE(ReductionOperator, Operator);
+ CharBlock source;
};
// R1130 locality-spec ->
// LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
-// REDUCE ( reduce-operation : variable-name-list ) |
+// REDUCE ( acc-reduction-op : variable-name-list ) |
// SHARED ( variable-name-list ) | DEFAULT ( NONE )
struct LocalitySpec {
UNION_CLASS_BOILERPLATE(LocalitySpec);
@@ -2261,7 +2262,8 @@ struct LocalitySpec {
WRAPPER_CLASS(LocalInit, std::list<Name>);
struct Reduce {
TUPLE_CLASS_BOILERPLATE(Reduce);
- std::tuple<ReduceOperation, std::list<Name>> t;
+ using Operator = ReductionOperator;
+ std::tuple<Operator, std::list<Name>> t;
};
WRAPPER_CLASS(Shared, std::list<Name>);
EMPTY_CLASS(DefaultNone);
@@ -4079,17 +4081,9 @@ struct AccObjectListWithModifier {
std::tuple<std::optional<AccDataModifier>, AccObjectList> t;
};
-// 2.5.15: + | * | max | min | iand | ior | ieor | .and. | .or. | .eqv. | .neqv.
-struct AccReductionOperator {
- ENUM_CLASS(
- Operator, Plus, Multiply, Max, Min, Iand, Ior, Ieor, And, Or, Eqv, Neqv)
- WRAPPER_CLASS_BOILERPLATE(AccReductionOperator, Operator);
- CharBlock source;
-};
-
struct AccObjectListWithReduction {
TUPLE_CLASS_BOILERPLATE(AccObjectListWithReduction);
- std::tuple<AccReductionOperator, AccObjectList> t;
+ std::tuple<ReductionOperator, AccObjectList> t;
};
struct AccWaitArgument {
@@ -4329,7 +4323,7 @@ struct OpenACCConstruct {
struct CUFReduction {
TUPLE_CLASS_BOILERPLATE(CUFReduction);
- using Operator = AccReductionOperator;
+ using Operator = ReductionOperator;
std::tuple<Operator, std::list<Scalar<Variable>>> t;
};
diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp
index b02e7be75d20f..c104eb6230169 100644
--- a/flang/lib/Lower/OpenACC.cpp
+++ b/flang/lib/Lower/OpenACC.cpp
@@ -829,29 +829,29 @@ genPrivatizations(const Fortran::parser::AccObjectList &objectList,
/// Return the corresponding enum value for the mlir::acc::ReductionOperator
/// from the parser representation.
static mlir::acc::ReductionOperator
-getReductionOperator(const Fortran::parser::AccReductionOperator &op) {
+getReductionOperator(const Fortran::parser::ReductionOperator &op) {
switch (op.v) {
- case Fortran::parser::AccReductionOperator::Operator::Plus:
+ case Fortran::parser::ReductionOperator::Operator::Plus:
return mlir::acc::ReductionOperator::AccAdd;
- case Fortran::parser::AccReductionOperator::Operator::Multiply:
+ case Fortran::parser::ReductionOperator::Operator::Multiply:
return mlir::acc::ReductionOperator::AccMul;
- case Fortran::parser::AccReductionOperator::Operator::Max:
+ case Fortran::parser::ReductionOperator::Operator::Max:
return mlir::acc::ReductionOperator::AccMax;
- case Fortran::parser::AccReductionOperator::Operator::Min:
+ case Fortran::parser::ReductionOperator::Operator::Min:
return mlir::acc::ReductionOperator::AccMin;
- case Fortran::parser::AccReductionOperator::Operator::Iand:
+ case Fortran::parser::ReductionOperator::Operator::Iand:
return mlir::acc::ReductionOperator::AccIand;
- case Fortran::parser::AccReductionOperator::Operator::Ior:
+ case Fortran::parser::ReductionOperator::Operator::Ior:
return mlir::acc::ReductionOperator::AccIor;
- case Fortran::parser::AccReductionOperator::Operator::Ieor:
+ case Fortran::parser::ReductionOperator::Operator::Ieor:
return mlir::acc::ReductionOperator::AccXor;
- case Fortran::parser::AccReductionOperator::Operator::And:
+ case Fortran::parser::ReductionOperator::Operator::And:
return mlir::acc::ReductionOperator::AccLand;
- case Fortran::parser::AccReductionOperator::Operator::Or:
+ case Fortran::parser::ReductionOperator::Operator::Or:
return mlir::acc::ReductionOperator::AccLor;
- case Fortran::parser::AccReductionOperator::Operator::Eqv:
+ case Fortran::parser::ReductionOperator::Operator::Eqv:
return mlir::acc::ReductionOperator::AccEqv;
- case Fortran::parser::AccReductionOperator::Operator::Neqv:
+ case Fortran::parser::ReductionOperator::Operator::Neqv:
return mlir::acc::ReductionOperator::AccNeqv;
}
llvm_unreachable("unexpected reduction operator");
@@ -1357,7 +1357,7 @@ genReductions(const Fortran::parser::AccObjectListWithReduction &objectList,
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const auto &objects = std::get<Fortran::parser::AccObjectList>(objectList.t);
const auto &op =
- std::get<Fortran::parser::AccReductionOperator>(objectList.t);
+ std::get<Fortran::parser::ReductionOperator>(objectList.t);
mlir::acc::ReductionOperator mlirOp = getReductionOperator(op);
Fortran::evaluate::ExpressionAnalyzer ea{semanticsContext};
for (const auto &accObject : objects.v) {
diff --git a/flang/lib/Parser/executable-parsers.cpp b/flang/lib/Parser/executable-parsers.cpp
index 6bacdb34f8c70..f703e09612d54 100644
--- a/flang/lib/Parser/executable-parsers.cpp
+++ b/flang/lib/Parser/executable-parsers.cpp
@@ -252,12 +252,6 @@ TYPE_PARSER(parenthesized(construct<ConcurrentHeader>(
TYPE_PARSER(construct<ConcurrentControl>(name / "=", scalarIntExpr / ":",
scalarIntExpr, maybe(":" >> scalarIntExpr)))
-// F'2023 R1131 reduce-operation ->
-// + | * | .AND. | .OR. | .EQV. | .NEQV. |
-// MAX | MIN | IAND | IOR | IEOR
-TYPE_PARSER(construct<ReduceOperation>(Parser<DefinedOperator>{}) ||
- construct<ReduceOperation>(Parser<ProcedureDesignator>{}))
-
// R1130 locality-spec ->
// LOCAL ( variable-name-list ) | LOCAL_INIT ( variable-name-list ) |
// REDUCE ( reduce-operation : variable-name-list ) |
@@ -267,7 +261,7 @@ TYPE_PARSER(construct<LocalitySpec>(construct<LocalitySpec::Local>(
construct<LocalitySpec>(construct<LocalitySpec::LocalInit>(
"LOCAL_INIT"_sptok >> parenthesized(listOfNames))) ||
construct<LocalitySpec>(construct<LocalitySpec::Reduce>(
- "REDUCE"_sptok >> "("_tok >> Parser<ReduceOperation>{} / ":",
+ "REDUCE (" >> Parser<LocalitySpec::Reduce::Operator>{} / ":",
listOfNames / ")")) ||
construct<LocalitySpec>(construct<LocalitySpec::Shared>(
"SHARED" >> parenthesized(listOfNames))) ||
diff --git a/flang/lib/Parser/openacc-parsers.cpp b/flang/lib/Parser/openacc-parsers.cpp
index 3d919e29a2482..c2e79835b916e 100644
--- a/flang/lib/Parser/openacc-parsers.cpp
+++ b/flang/lib/Parser/openacc-parsers.cpp
@@ -39,7 +39,7 @@ TYPE_PARSER(construct<AccObjectListWithModifier>(
maybe(Parser<AccDataModifier>{}), Parser<AccObjectList>{}))
TYPE_PARSER(construct<AccObjectListWithReduction>(
- Parser<AccReductionOperator>{} / ":", Parser<AccObjectList>{}))
+ Parser<ReductionOperator>{} / ":", Parser<AccObjectList>{}))
// 2.16 (3249) wait-argument is:
// [devnum : int-expr :] [queues :] int-expr-list
@@ -94,18 +94,18 @@ TYPE_PARSER(construct<AccCollapseArg>(
// 2.5.15 Reduction
// Operator for reduction
-TYPE_PARSER(sourced(construct<AccReductionOperator>(
- first("+" >> pure(AccReductionOperator::Operator::Plus),
- "*" >> pure(AccReductionOperator::Operator::Multiply),
- "MAX" >> pure(AccReductionOperator::Operator::Max),
- "MIN" >> pure(AccReductionOperator::Operator::Min),
- "IAND" >> pure(AccReductionOperator::Operator::Iand),
- "IOR" >> pure(AccReductionOperator::Operator::Ior),
- "IEOR" >> pure(AccReductionOperator::Operator::Ieor),
- ".AND." >> pure(AccReductionOperator::Operator::And),
- ".OR." >> pure(AccReductionOperator::Operator::Or),
- ".EQV." >> pure(AccReductionOperator::Operator::Eqv),
- ".NEQV." >> pure(AccReductionOperator::Operator::Neqv)))))
+TYPE_PARSER(sourced(construct<ReductionOperator>(
+ first("+" >> pure(ReductionOperator::Operator::Plus),
+ "*" >> pure(ReductionOperator::Operator::Multiply),
+ "MAX" >> pure(ReductionOperator::Operator::Max),
+ "MIN" >> pure(ReductionOperator::Operator::Min),
+ "IAND" >> pure(ReductionOperator::Operator::Iand),
+ "IOR" >> pure(ReductionOperator::Operator::Ior),
+ "IEOR" >> pure(ReductionOperator::Operator::Ieor),
+ ".AND." >> pure(ReductionOperator::Operator::And),
+ ".OR." >> pure(ReductionOperator::Operator::Or),
+ ".EQV." >> pure(ReductionOperator::Operator::Eqv),
+ ".NEQV." >> pure(ReductionOperator::Operator::Neqv)))))
// 2.15.1 Bind clause
TYPE_PARSER(sourced(construct<AccBindClause>(name)) ||
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 969b9c3a3802b..ff452e5db0302 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1039,8 +1039,8 @@ class UnparseVisitor {
Word("LOCAL_INIT("), Walk(x.v, ", "), Put(')');
}
void Unparse(const LocalitySpec::Reduce &x) {
- Word("REDUCE("), Walk(std::get<parser::ReduceOperation>(x.t)), Put(':');
- Walk(std::get<std::list<parser::Name>>(x.t), ", "), Put(')');
+ Word("REDUCE("), Walk(std::get<parser::ReductionOperator>(x.t));
+ Walk(":", std::get<std::list<parser::Name>>(x.t), ",", ")");
}
void Unparse(const LocalitySpec::Shared &x) {
Word("SHARED("), Walk(x.v, ", "), Put(')');
@@ -2022,7 +2022,7 @@ class UnparseVisitor {
}
void Unparse(const AccObjectList &x) { Walk(x.v, ","); }
void Unparse(const AccObjectListWithReduction &x) {
- Walk(std::get<AccReductionOperator>(x.t));
+ Walk(std::get<ReductionOperator>(x.t));
Put(":");
Walk(std::get<AccObjectList>(x.t));
}
@@ -2739,28 +2739,28 @@ class UnparseVisitor {
WALK_NESTED_ENUM(OmpOrderClause, Type) // OMP order-type
WALK_NESTED_ENUM(OmpOrderModifier, Kind) // OMP order-modifier
#undef WALK_NESTED_ENUM
- void Unparse(const AccReductionOperator::Operator x) {
+ void Unparse(const ReductionOperator::Operator x) {
switch (x) {
- case AccReductionOperator::Operator::Plus:
+ case ReductionOperator::Operator::Plus:
Word("+");
break;
- case AccReductionOperator::Operator::Multiply:
+ case ReductionOperator::Operator::Multiply:
Word("*");
break;
- case AccReductionOperator::Operator::And:
+ case ReductionOperator::Operator::And:
Word(".AND.");
break;
- case AccReductionOperator::Operator::Or:
+ case ReductionOperator::Operator::Or:
Word(".OR.");
break;
- case AccReductionOperator::Operator::Eqv:
+ case ReductionOperator::Operator::Eqv:
Word(".EQV.");
break;
- case AccReductionOperator::Operator::Neqv:
+ case ReductionOperator::Operator::Neqv:
Word(".NEQV.");
break;
default:
- Word(AccReductionOperator::EnumToString(x));
+ Word(ReductionOperator::EnumToString(x));
break;
}
}
diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index 18704b53c66f1..69b9fe17e6a88 100644
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -22,33 +22,33 @@
}
using ReductionOpsSet =
- Fortran::common::EnumSet<Fortran::parser::AccReductionOperator::Operator,
- Fortran::parser::AccReductionOperator::Operator_enumSize>;
+ Fortran::common::EnumSet<Fortran::parser::ReductionOperator::Operator,
+ Fortran::parser::ReductionOperator::Operator_enumSize>;
static ReductionOpsSet reductionIntegerSet{
- Fortran::parser::AccReductionOperator::Operator::Plus,
- Fortran::parser::AccReductionOperator::Operator::Multiply,
- Fortran::parser::AccReductionOperator::Operator::Max,
- Fortran::parser::AccReductionOperator::Operator::Min,
- Fortran::parser::AccReductionOperator::Operator::Iand,
- Fortran::parser::AccReductionOperator::Operator::Ior,
- Fortran::parser::AccReductionOperator::Operator::Ieor};
+ Fortran::parser::ReductionOperator::Operator::Plus,
+ Fortran::parser::ReductionOperator::Operator::Multiply,
+ Fortran::parser::ReductionOperator::Operator::Max,
+ Fortran::parser::ReductionOperator::Operator::Min,
+ Fortran::parser::ReductionOperator::Operator::Iand,
+ Fortran::parser::ReductionOperator::Operator::Ior,
+ Fortran::parser::ReductionOperator::Operator::Ieor};
static ReductionOpsSet reductionRealSet{
- Fortran::parser::AccReductionOperator::Operator::Plus,
- Fortran::parser::AccReductionOperator::Operator::Multiply,
- Fortran::parser::AccReductionOperator::Operator::Max,
- Fortran::parser::AccReductionOperator::Operator::Min};
+ Fortran::parser::ReductionOperator::Operator::Plus,
+ Fortran::parser::ReductionOperator::Operator::Multiply,
+ Fortran::parser::ReductionOperator::Operator::Max,
+ Fortran::parser::ReductionOperator::Operator::Min};
static ReductionOpsSet reductionComplexSet{
- Fortran::parser::AccReductionOperator::Operator::Plus,
- Fortran::parser::AccReductionOperator::Operator::Multiply};
+ Fortran::parser::ReductionOperator::Operator::Plus,
+ Fortran::parser::ReductionOperator::Operator::Multiply};
static ReductionOpsSet reductionLogicalSet{
- Fortran::parser::AccReductionOperator::Operator::And,
- Fortran::parser::AccReductionOperator::Operator::Or,
- Fortran::parser::AccReductionOperator::Operator::Eqv,
- Fortran::parser::AccReductionOperator::Operator::Neqv};
+ Fortran::parser::ReductionOperator::Operator::And,
+ Fortran::parser::ReductionOperator::Operator::Or,
+ Fortran::parser::ReductionOperator::Operator::Eqv,
+ Fortran::parser::ReductionOperator::Operator::Neqv};
namespace Fortran::semantics {
@@ -670,7 +670,7 @@ void AccStructureChecker::Enter(const parser::AccClause::Reduction &reduction) {
// The following check that the reduction operator is supported with the given
// type.
const parser::AccObjectListWithReduction &list{reduction.v};
- const auto &op{std::get<parser::AccReductionOperator>(list.t)};
+ const auto &op{std::get<parser::ReductionOperator>(list.t)};
const auto &objects{std::get<parser::AccObjectList>(list.t)};
for (const auto &object : objects.v) {
diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp
index 45217ed2e3ccd..8af50cac8ef56 100644
--- a/flang/lib/Semantics/check-cuda.cpp
+++ b/flang/lib/Semantics/check-cuda.cpp
@@ -475,21 +475,21 @@ static void CheckReduce(
auto cat{type->category()};
bool isOk{false};
switch (op) {
- case parser::AccReductionOperator::Operator::Plus:
- case parser::AccReductionOperator::Operator::Multiply:
- case parser::AccReductionOperator::Operator::Max:
- case parser::AccReductionOperator::Operator::Min:
+ case parser::ReductionOperator::Operator::Plus:
+ case parser::ReductionOperator::Operator::Multiply:
+ case parser::ReductionOperator::Operator::Max:
+ case parser::ReductionOperator::Operator::Min:
isOk = cat == TypeCategory::Integer || cat == TypeCategory::Real;
break;
- case parser::AccReductionOperator::Operator::Iand:
- case parser::AccReductionOperator::Operator::Ior:
- case parser::AccReductionOperator::Operator::Ieor:
+ case parser::ReductionOperator::Operator::Iand:
+ case parser::ReductionOperator::Operator::Ior:
+ case parser::ReductionOperator::Operator::Ieor:
isOk = cat == TypeCategory::Integer;
break;
- case parser::AccReductionOperator::Operator::And:
- case parser::AccReductionOperator::Operator::Or:
- case parser::AccReductionOperator::Operator::Eqv:
- case parser::AccReductionOperator::Operator::Neqv:
+ case parser::ReductionOperator::Operator::And:
+ case parser::ReductionOperator::Operator::Or:
+ case parser::ReductionOperator::Operator::Eqv:
+ case parser::ReductionOperator::Operator::Neqv:
isOk = cat == TypeCategory::Logical;
break;
}
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index 450a6ccda172b..37ca306d6812c 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -88,8 +88,8 @@ class DoConcurrentBodyEnforce {
public:
DoConcurrentBodyEnforce(
SemanticsContext &context, parser::CharBlock doConcurrentSourcePosition)
- : context_{context}, doConcurrentSourcePosition_{
- doConcurrentSourcePosition} {}
+ : context_{context},
+ doConcurrentSourcePosition_{doConcurrentSourcePosition} {}
std::set<parser::Label> labels() { return labels_; }
template <typename T> bool Pre(const T &x) {
if (const auto *expr{GetExpr(context_, x)}) {
@@ -683,86 +683,61 @@ class DoContext {
}
}
- void CheckReduce(
- const parser::LocalitySpec::Reduce &reduce) const {
- const parser::ReduceOperation &reduceOperation =
- std::get<parser::ReduceOperation>(reduce.t);
+ void CheckReduce(const parser::LocalitySpec::Reduce &reduce) const {
+ const parser::ReductionOperator &reductionOperator{
+ std::get<parser::ReductionOperator>(reduce.t)};
// F'2023 C1132, reduction variables should have suitable intrinsic type
- bool supported_identifier = true;
- common::visit(
- common::visitors{
- [&](const parser::DefinedOperator &dOpr) {
- const auto &intrinsicOp{
- std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)
- };
- for (const Fortran::parser::Name &x :
- std::get<std::list<Fortran::parser::Name>>(reduce.t)) {
- const auto *type{x.symbol->GetType()};
- bool suitable_type = false;
- switch (intrinsicOp) {
- case parser::DefinedOperator::IntrinsicOperator::Add:
- case parser::DefinedOperator::IntrinsicOperator::Multiply:
- if (type->IsNumeric(TypeCategory::Integer) ||
- type->IsNumeric(TypeCategory::Real) ||
- type->IsNumeric(TypeCategory::Complex)) {
- // TODO: check composite type.
- suitable_type = true;
- }
- break;
- case parser::DefinedOperator::IntrinsicOperator::AND:
- case parser::DefinedOperator::IntrinsicOperator::OR:
- case parser::DefinedOperator::IntrinsicOperator::EQV:
- case parser::DefinedOperator::IntrinsicOperator::NEQV:
- if (type->category() == DeclTypeSpec::Category::Logical) {
- suitable_type = true;
- }
- break;
- default:
- supported_identifier = false;
- return;
- }
- if (!suitable_type) {
- context_.Say(currentStatementSourcePosition_,
- "Reduction variable '%s' does not have a "
- "suitable type."_err_en_US, x.symbol->name());
- }
- }
- },
- [&](const parser::ProcedureDesignator &procD) {
- const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
- if (!(name && name->symbol)) {
- supported_identifier = false;
- return;
- }
- const SourceName &realName{name->symbol->GetUltimate().name()};
- for (const Fortran::parser::Name &x : std::get<std::list<
- Fortran::parser::Name>>(reduce.t)) {
- const auto *type{x.symbol->GetType()};
- bool suitable_type = false;
- if (realName == "max" || realName == "min") {
- if (type->IsNumeric(TypeCategory::Integer) ||
- type->IsNumeric(TypeCategory::Real))
- suitable_type = true;
- } else if (realName == "iand" || realName == "ior" ||
- realName == "ieor") {
- if (type->IsNumeric(TypeCategory::Integer))
- suitable_type = true;
- } else {
- supported_identifier = false;
- return;
- }
- if (!suitable_type) {
- context_.Say(currentStatementSourcePosition_,
- "Reduction variable '%s' does not have a "
- "suitable type."_err_en_US, x.symbol->name());
- }
- }
- }
- },
- reduceOperation.u);
- if (!supported_identifier) {
- context_.Say(currentStatementSourcePosition_,
- "Invalid reduction identifier in REDUCE clause."_err_en_US);
+ for (const parser::Name &x : std::get<std::list<parser::Name>>(reduce.t)) {
+ bool supported_identifier{false};
+ if (x.symbol && x.symbol->GetType()) {
+ const auto *type{x.symbol->GetType()};
+ auto type_mismatch = [&](const char *suitable_types) {
+ context_.Say(currentStatementSourcePosition_,
+ "Reduction variable '%s' ('%s') does not have a "
+ "suitable type ('%s')."_err_en_US,
+ x.symbol->name(), type->AsFortran(), suitable_types);
+ };
+ supported_identifier = true;
+ switch (reductionOperator.v) {
+ case parser::ReductionOperator::Operator::Plus:
+ case parser::ReductionOperator::Operator::Multiply:
+ if (!(type->IsNumeric(TypeCategory::Complex) ||
+ type->IsNumeric(TypeCategory::Integer) ||
+ type->IsNumeric(TypeCategory::Real))) {
+ type_mismatch("COMPLEX', 'INTEGER', 'REAL");
+ }
+ break;
+ case parser::ReductionOperator::Operator::And:
+ case parser::ReductionOperator::Operator::Or:
+ case parser::ReductionOperator::Operator::Eqv:
+ case parser::ReductionOperator::Operator::Neqv:
+ if (type->category() != DeclTypeSpec::Category::Logical) {
+ type_mismatch("LOGICAL");
+ }
+ break;
+ case parser::ReductionOperator::Operator::Max:
+ case parser::ReductionOperator::Operator::Min:
+ if (!(type->IsNumeric(TypeCategory::Integer) ||
+ type->IsNumeric(TypeCategory::Real))) {
+ type_mismatch("INTEGER', 'REAL");
+ }
+ break;
+ case parser::ReductionOperator::Operator::Iand:
+ case parser::ReductionOperator::Operator::Ior:
+ case parser::ReductionOperator::Operator::Ieor:
+ if (!type->IsNumeric(TypeCategory::Integer)) {
+ type_mismatch("INTEGER");
+ }
+ break;
+ default:
+ supported_identifier = false;
+ break;
+ }
+ }
+ if (!supported_identifier) {
+ context_.Say(currentStatementSourcePosition_,
+ "Invalid identifier in REDUCE clause."_err_en_US);
+ }
}
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 61f0811982feb..62965cf8931c3 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -538,8 +538,8 @@ class ScopeHandler : public ImplicitRulesVisitor {
void SayWithReason(
const parser::Name &, Symbol &, MessageFixedText &&, Message &&);
template <typename... A>
- void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&,
- A &&...args);
+ void SayWithDecl(
+ const parser::Name &, Symbol &, MessageFixedText &&, A &&...args);
void SayLocalMustBeVariable(const parser::Name &, Symbol &);
void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
@@ -1043,10 +1043,10 @@ class DeclarationVisitor : public ArraySpecVisitor,
Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
// Make sure that there's an entity in an enclosing scope called Name
Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
- // Declare a LOCAL/LOCAL_INIT/REDUCE entity. If there isn't a type specified
- // it comes from the entity in the containing scope, or implicit rules.
- // Return pointer to the new symbol, or nullptr on error.
- Symbol *DeclareLocalEntity(const parser::Name &, Symbol::Flag);
+ // Declare a LOCAL/LOCAL_INIT/REDUCE entity while setting a locality flag. If
+ // there isn't a type specified it comes from the entity in the containing
+ // scope, or implicit rules.
+ void DeclareLocalEntity(const parser::Name &, Symbol::Flag);
// Declare a statement entity (i.e., an implied DO loop index for
// a DATA statement or an array constructor). If there isn't an explict
// type specified, implicit rules apply. Return pointer to the new symbol,
@@ -1147,8 +1147,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
void Initialization(const parser::Name &, const parser::Initialization &,
bool inComponentDecl);
- bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol,
- Symbol::Flag flag);
+ bool PassesLocalityChecks(
+ const parser::Name &name, Symbol &symbol, Symbol::Flag flag);
bool CheckForHostAssociatedImplicit(const parser::Name &);
// Declare an object or procedure entity.
@@ -1577,7 +1577,6 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
ResolveName(*parser::Unwrap<parser::Name>(x.name));
}
void Post(const parser::ProcComponentRef &);
- bool Pre(const parser::ReduceOperation &);
bool Pre(const parser::FunctionReference &);
bool Pre(const parser::CallStmt &);
bool Pre(const parser::ImportStmt &);
@@ -2259,16 +2258,16 @@ void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
context().SetError(symbol, isFatal);
}
-template <typename... A> void ScopeHandler::SayWithDecl(
- const parser::Name &name, Symbol &symbol, MessageFixedText &&msg,
- A &&...args) {
- auto &message{Say(name.source, std::move(msg), symbol.name(),
- std::forward<A>(args)...)
- .Attach(Message{symbol.name(),
- symbol.test(Symbol::Flag::Implicit)
- ? "Implicit declaration of '%s'"_en_US
- : "Declaration of '%s'"_en_US,
- name.source})};
+template <typename... A>
+void ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,
+ MessageFixedText &&msg, A &&...args) {
+ auto &message{
+ Say(name.source, std::move(msg), symbol.name(), std::forward<A>(args)...)
+ .Attach(Message{symbol.name(),
+ symbol.test(Symbol::Flag::Implicit)
+ ? "Implicit declaration of '%s'"_en_US
+ : "Declaration of '%s'"_en_US,
+ name.source})};
if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
if (auto usedAsProc{proc->usedAsProcedureHere()}) {
if (usedAsProc->begin() != symbol.name().begin()) {
@@ -5501,7 +5500,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
std::optional<DerivedTypeSpec> extendsType{
ResolveExtendsType(name, extendsName)};
DerivedTypeDetails derivedTypeDetails;
- if (Symbol *typeSymbol{FindInScope(currScope(), name)}; typeSymbol &&
+ if (Symbol * typeSymbol{FindInScope(currScope(), name)}; typeSymbol &&
typeSymbol->has<DerivedTypeDetails>() &&
typeSymbol->get<DerivedTypeDetails>().isForwardReferenced()) {
derivedTypeDetails.set_isForwardReferenced(true);
@@ -6468,39 +6467,43 @@ bool DeclarationVisitor::PassesSharedLocalityChecks(
// Checks for locality-specs LOCAL, LOCAL_INIT, and REDUCE
bool DeclarationVisitor::PassesLocalityChecks(
const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
- bool isReduce = flag == Symbol::Flag::LocalityReduce;
- if (IsAllocatable(symbol) && !isReduce) { // C1128, F'2023 C1130
- SayWithDecl(name, symbol, "ALLOCATABLE variable '%s' not allowed in a "
+ bool isReduce{flag == Symbol::Flag::LocalityReduce};
+ if (IsAllocatable(symbol) && !isReduce) { // F'2023 C1130
+ SayWithDecl(name, symbol,
+ "ALLOCATABLE variable '%s' not allowed in a "
"LOCAL%s locality-spec"_err_en_US,
- (flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
+ flag == Symbol::Flag::LocalityLocalInit ? "_INIT" : "");
return false;
}
- if (IsOptional(symbol)) { // C1128, F'2023 C1130-C1131
+ if (IsOptional(symbol)) { // F'2023 C1130-C1131
SayWithDecl(name, symbol,
"OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
return false;
}
- if (IsIntentIn(symbol)) { // C1128, F'2023 C1130-C1131
+ if (IsIntentIn(symbol)) { // F'2023 C1130-C1131
SayWithDecl(name, symbol,
"INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
return false;
}
- if (IsFinalizable(symbol) && !isReduce) { // C1128, F'2023 C1130
- SayWithDecl(name, symbol, "Finalizable variable '%s' not allowed in a "
+ if (IsFinalizable(symbol) && !isReduce) { // F'2023 C1130
+ SayWithDecl(name, symbol,
+ "Finalizable variable '%s' not allowed in a "
"LOCAL%s locality-spec"_err_en_US,
(flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
}
- if (evaluate::IsCoarray(symbol) && !isReduce) { // C1128, F'2023 C1130
- SayWithDecl(name, symbol, "Coarray '%s' not allowed in a "
+ if (evaluate::IsCoarray(symbol) && !isReduce) { // F'2023 C1130
+ SayWithDecl(name, symbol,
+ "Coarray '%s' not allowed in a "
"LOCAL%s locality-spec"_err_en_US,
(flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
}
if (const DeclTypeSpec * type{symbol.GetType()}) {
- if (type->IsPolymorphic() && IsDummy(symbol) &&
- !IsPointer(symbol) && !isReduce) { // C1128, F'2023 C1130
- SayWithDecl(name, symbol, "Nonpointer polymorphic argument '%s' not "
+ if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&
+ !isReduce) { // F'2023 C1130
+ SayWithDecl(name, symbol,
+ "Nonpointer polymorphic argument '%s' not "
"allowed in a LOCAL%s locality-spec"_err_en_US,
(flag == Symbol::Flag::LocalityLocalInit) ? "_INIT" : "");
return false;
@@ -6518,7 +6521,7 @@ bool DeclarationVisitor::PassesLocalityChecks(
"REDUCE locality-spec"_err_en_US);
return false;
}
- if (IsAssumedSizeArray(symbol)) { // C1128, F'2023 C1130-C1131
+ if (IsAssumedSizeArray(symbol)) { // F'2023 C1130-C1131
SayWithDecl(name, symbol,
"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
return false;
@@ -6547,13 +6550,14 @@ Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
return *prev;
}
-Symbol *DeclarationVisitor::DeclareLocalEntity(
+void DeclarationVisitor::DeclareLocalEntity(
const parser::Name &name, Symbol::Flag flag) {
Symbol &prev{FindOrDeclareEnclosingEntity(name)};
- if (!PassesLocalityChecks(name, prev, flag)) {
- return nullptr;
+ if (PassesLocalityChecks(name, prev, flag)) {
+ if (auto *symbol{&MakeHostAssocSymbol(name, prev)}) {
+ symbol->set(flag);
+ }
}
- return &MakeHostAssocSymbol(name, prev);
}
Symbol *DeclarationVisitor::DeclareStatementEntity(
@@ -6890,30 +6894,21 @@ bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
for (auto &name : x.v) {
- if (auto *symbol{DeclareLocalEntity(name, Symbol::Flag::LocalityLocal)}) {
- symbol->set(Symbol::Flag::LocalityLocal);
- }
+ DeclareLocalEntity(name, Symbol::Flag::LocalityLocal);
}
return false;
}
bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
for (auto &name : x.v) {
- if (auto *symbol{
- DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit)}) {
- symbol->set(Symbol::Flag::LocalityLocalInit);
- }
+ DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit);
}
return false;
}
bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {
- Walk(std::get<parser::ReduceOperation>(x.t));
for (auto &name : std::get<std::list<parser::Name>>(x.t)) {
- if (auto *symbol{
- DeclareLocalEntity(name, Symbol::Flag::LocalityReduce)}) {
- symbol->set(Symbol::Flag::LocalityReduce);
- }
+ DeclareLocalEntity(name, Symbol::Flag::LocalityReduce);
}
return false;
}
@@ -7012,23 +7007,22 @@ bool ConstructVisitor::Pre(const parser::DataStmtObject &x) {
// When a name first appears as an object in a DATA statement, it should
// be implicitly declared locally as if it had been assigned.
auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
- common::visit(common::visitors{
- [&](const Indirection<parser::Variable> &y) {
- auto restorer{
- common::ScopedSet(deferImplicitTyping_, true)};
- Walk(y.value());
- const parser::Name &first{
- parser::GetFirstName(y.value())};
- if (first.symbol) {
- first.symbol->set(Symbol::Flag::InDataStmt);
- }
- },
- [&](const parser::DataImpliedDo &y) {
- PushScope(Scope::Kind::ImpliedDos, nullptr);
- Walk(y);
- PopScope();
- },
- },
+ common::visit(
+ common::visitors{
+ [&](const Indirection<parser::Variable> &y) {
+ auto restorer{common::ScopedSet(deferImplicitTyping_, true)};
+ Walk(y.value());
+ const parser::Name &first{parser::GetFirstName(y.value())};
+ if (first.symbol) {
+ first.symbol->set(Symbol::Flag::InDataStmt);
+ }
+ },
+ [&](const parser::DataImpliedDo &y) {
+ PushScope(Scope::Kind::ImpliedDos, nullptr);
+ Walk(y);
+ PopScope();
+ },
+ },
x.u);
return false;
}
@@ -8252,15 +8246,6 @@ void ResolveNamesVisitor::HandleProcedureName(
}
}
-bool ResolveNamesVisitor::Pre(const parser::ReduceOperation &x) {
- if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(x.u)}) {
- if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
- HandleProcedureName(Symbol::Flag::Function, *name);
- }
- }
- return false;
-}
-
bool ResolveNamesVisitor::CheckImplicitNoneExternal(
const SourceName &name, const Symbol &symbol) {
if (symbol.has<ProcEntityDetails>() && isImplicitNoneExternal() &&
diff --git a/flang/test/Semantics/resolve124.f90 b/flang/test/Semantics/resolve124.f90
index efb920c6f5d7f..e8ac56eb6826f 100644
--- a/flang/test/Semantics/resolve124.f90
+++ b/flang/test/Semantics/resolve124.f90
@@ -20,10 +20,10 @@ end subroutine s1
subroutine s2()
! Cannot apply logical operations to integer variables
integer :: i1, i2, i3, i4
-!ERROR: Reduction variable 'i1' does not have a suitable type.
-!ERROR: Reduction variable 'i2' does not have a suitable type.
-!ERROR: Reduction variable 'i3' does not have a suitable type.
-!ERROR: Reduction variable 'i4' does not have a suitable type.
+!ERROR: Reduction variable 'i1' ('INTEGER(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'i2' ('INTEGER(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'i3' ('INTEGER(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'i4' ('INTEGER(4)') does not have a suitable type ('LOGICAL').
do concurrent(i=1:5) &
& reduce(.and.:i1) reduce(.or.:i2) reduce(.eqv.:i3) reduce(.neqv.:i4)
end do
@@ -32,13 +32,13 @@ end subroutine s2
subroutine s3()
! Cannot apply integer/logical operations to real variables
real :: r1, r2, r3, r4
-!ERROR: Reduction variable 'r1' does not have a suitable type.
-!ERROR: Reduction variable 'r2' does not have a suitable type.
-!ERROR: Reduction variable 'r3' does not have a suitable type.
-!ERROR: Reduction variable 'r4' does not have a suitable type.
-!ERROR: Reduction variable 'r5' does not have a suitable type.
-!ERROR: Reduction variable 'r6' does not have a suitable type.
-!ERROR: Reduction variable 'r7' does not have a suitable type.
+!ERROR: Reduction variable 'r1' ('REAL(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'r2' ('REAL(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'r3' ('REAL(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'r4' ('REAL(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'r5' ('REAL(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'r6' ('REAL(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'r7' ('REAL(4)') does not have a suitable type ('LOGICAL').
do concurrent(i=1:5) &
& reduce(iand:r1) reduce(ieor:r2) reduce(ior:r3) reduce(.and.:r4) &
& reduce(.or.:r5) reduce(.eqv.:r6) reduce(.neqv.:r7)
@@ -48,15 +48,15 @@ end subroutine s3
subroutine s4()
! Cannot apply integer/logical operations to complex variables
complex :: c1, c2, c3, c4, c5, c6, c7, c8, c9
-!ERROR: Reduction variable 'c1' does not have a suitable type.
-!ERROR: Reduction variable 'c2' does not have a suitable type.
-!ERROR: Reduction variable 'c3' does not have a suitable type.
-!ERROR: Reduction variable 'c4' does not have a suitable type.
-!ERROR: Reduction variable 'c5' does not have a suitable type.
-!ERROR: Reduction variable 'c6' does not have a suitable type.
-!ERROR: Reduction variable 'c7' does not have a suitable type.
-!ERROR: Reduction variable 'c8' does not have a suitable type.
-!ERROR: Reduction variable 'c9' does not have a suitable type.
+!ERROR: Reduction variable 'c1' ('COMPLEX(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'c2' ('COMPLEX(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'c3' ('COMPLEX(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'c4' ('COMPLEX(4)') does not have a suitable type ('INTEGER', 'REAL').
+!ERROR: Reduction variable 'c5' ('COMPLEX(4)') does not have a suitable type ('INTEGER', 'REAL').
+!ERROR: Reduction variable 'c6' ('COMPLEX(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'c7' ('COMPLEX(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'c8' ('COMPLEX(4)') does not have a suitable type ('LOGICAL').
+!ERROR: Reduction variable 'c9' ('COMPLEX(4)') does not have a suitable type ('LOGICAL').
do concurrent(i=1:5) &
& reduce(iand:c1) reduce(ieor:c2) reduce(ior:c3) reduce(max:c4) &
& reduce(min:c5) reduce(.and.:c6) reduce(.or.:c7) reduce(.eqv.:c8) &
@@ -67,13 +67,13 @@ end subroutine s4
subroutine s5()
! Cannot apply integer operations to logical variables
logical :: l1, l2, l3, l4, l5, l6, l7
-!ERROR: Reduction variable 'l1' does not have a suitable type.
-!ERROR: Reduction variable 'l2' does not have a suitable type.
-!ERROR: Reduction variable 'l3' does not have a suitable type.
-!ERROR: Reduction variable 'l4' does not have a suitable type.
-!ERROR: Reduction variable 'l5' does not have a suitable type.
-!ERROR: Reduction variable 'l6' does not have a suitable type.
-!ERROR: Reduction variable 'l7' does not have a suitable type.
+!ERROR: Reduction variable 'l1' ('LOGICAL(4)') does not have a suitable type ('COMPLEX', 'INTEGER', 'REAL').
+!ERROR: Reduction variable 'l2' ('LOGICAL(4)') does not have a suitable type ('COMPLEX', 'INTEGER', 'REAL').
+!ERROR: Reduction variable 'l3' ('LOGICAL(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'l4' ('LOGICAL(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'l5' ('LOGICAL(4)') does not have a suitable type ('INTEGER').
+!ERROR: Reduction variable 'l6' ('LOGICAL(4)') does not have a suitable type ('INTEGER', 'REAL').
+!ERROR: Reduction variable 'l7' ('LOGICAL(4)') does not have a suitable type ('INTEGER', 'REAL').
do concurrent(i=1:5) &
& reduce(+:l1) reduce(*:l2) reduce(iand:l3) reduce(ieor:l4) &
& reduce(ior:l5) reduce(max:l6) reduce(min:l7)
@@ -83,7 +83,7 @@ end subroutine s5
subroutine s6()
! Cannot reduce a character
character ch
-!ERROR: Reduction variable 'ch' does not have a suitable type.
+!ERROR: Reduction variable 'ch' ('CHARACTER(1_8,1)') does not have a suitable type ('COMPLEX', 'INTEGER', 'REAL').
do concurrent(i=1:5) reduce(+:ch)
end do
end subroutine s6
>From fb82dc2e275d9bf9d75266913b0d52f7d64e20fe Mon Sep 17 00:00:00 2001
From: Kazuaki Matsumura <kmatsumura at nvidia.com>
Date: Mon, 20 May 2024 12:31:02 -0700
Subject: [PATCH 3/4] [flang] Braced initialization with lambda expression
---
flang/lib/Semantics/check-do-forall.cpp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index 37ca306d6812c..c14fe371cac3f 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -691,12 +691,12 @@ class DoContext {
bool supported_identifier{false};
if (x.symbol && x.symbol->GetType()) {
const auto *type{x.symbol->GetType()};
- auto type_mismatch = [&](const char *suitable_types) {
+ auto type_mismatch{[&](const char *suitable_types) {
context_.Say(currentStatementSourcePosition_,
"Reduction variable '%s' ('%s') does not have a "
"suitable type ('%s')."_err_en_US,
x.symbol->name(), type->AsFortran(), suitable_types);
- };
+ }};
supported_identifier = true;
switch (reductionOperator.v) {
case parser::ReductionOperator::Operator::Plus:
>From 66b0edd8464cf0245be08ade53d1d483a91d0105 Mon Sep 17 00:00:00 2001
From: Kazuaki Matsumura <kmatsumura at nvidia.com>
Date: Mon, 20 May 2024 12:48:47 -0700
Subject: [PATCH 4/4] [flang] Drop the F'2018 number
---
flang/test/Semantics/resolve55.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/test/Semantics/resolve55.f90 b/flang/test/Semantics/resolve55.f90
index 54ecb341a82e4..0a40a19435748 100644
--- a/flang/test/Semantics/resolve55.f90
+++ b/flang/test/Semantics/resolve55.f90
@@ -1,5 +1,5 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! Tests for C1128 and F'2023 C1130:
+! Tests for F'2023 C1130:
! A variable-name that appears in a LOCAL or LOCAL_INIT locality-spec shall not
! have the ALLOCATABLE; INTENT (IN); or OPTIONAL attribute; shall not be of
! finalizable type; shall not be a nonpointer polymorphic dummy argument; and
More information about the flang-commits
mailing list