[flang-commits] [flang] 3af717d - [flang] Add parsing of DO CONCURRENT REDUCE clause (#92518)
via flang-commits
flang-commits at lists.llvm.org
Thu May 30 11:34:24 PDT 2024
Author: khaki3
Date: 2024-05-30T11:34:19-07:00
New Revision: 3af717d661e9fe8d562181b933a373ca58e41b27
URL: https://github.com/llvm/llvm-project/commit/3af717d661e9fe8d562181b933a373ca58e41b27
DIFF: https://github.com/llvm/llvm-project/commit/3af717d661e9fe8d562181b933a373ca58e41b27.diff
LOG: [flang] Add parsing of DO CONCURRENT REDUCE clause (#92518)
Derived from #92480. This PR supports parsing of the DO CONCURRENT
REDUCE clause in Fortran 2023. Following the style of the OpenMP parser
in MLIR, the front end accepts both arbitrary operations and procedures
for the REDUCE clause. But later Semantics can notify type errors and
resolve procedure names.
Added:
flang/test/Semantics/resolve123.f90
flang/test/Semantics/resolve124.f90
Modified:
flang/examples/FeatureList/FeatureList.cpp
flang/include/flang/Parser/dump-parse-tree.h
flang/include/flang/Parser/parse-tree.h
flang/include/flang/Semantics/symbol.h
flang/lib/Lower/OpenACC.cpp
flang/lib/Parser/executable-parsers.cpp
flang/lib/Parser/openacc-parsers.cpp
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/check-acc-structure.cpp
flang/lib/Semantics/check-cuda.cpp
flang/lib/Semantics/check-do-forall.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/resolve55.f90
Removed:
################################################################################
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 3ca92da4f6467..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,10 +408,13 @@ struct NodeVisitor {
READ_FEATURE(LetterSpec)
READ_FEATURE(LiteralConstant)
READ_FEATURE(IntLiteralConstant)
+ READ_FEATURE(ReductionOperator)
+ READ_FEATURE(ReductionOperator::Operator)
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..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,10 +434,13 @@ class ParseTreeDumper {
NODE(parser, LetterSpec)
NODE(parser, LiteralConstant)
NODE(parser, IntLiteralConstant)
+ NODE(parser, ReductionOperator)
+ NODE_ENUM(parser::ReductionOperator, Operator)
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..2853a9c72239c 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -2236,16 +2236,34 @@ struct ConcurrentHeader {
t;
};
+// F'2023 R1131 reduce-operation -> reduction-operator
+// CUF reduction-op -> reduction-operator
+// OpenACC 3.3 2.5.15 reduction-operator ->
+// + | * | .AND. | .OR. | .EQV. | .NEQV. |
+// MAX | MIN | IAND | IOR | IEOR
+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 ) |
// 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);
+ using Operator = ReductionOperator;
+ std::tuple<Operator, 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 ->
@@ -4066,17 +4084,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 {
@@ -4312,11 +4322,11 @@ struct OpenACCConstruct {
// block -> * | scalar-int-expr | ( star-or-expr-list )
// stream -> 0, scalar-int-expr | STREAM = scalar-int-expr
// cuf-reduction -> [ REDUCE | REDUCTION ] (
-// acc-reduction-op : scalar-variable-list )
+// reduction-op : scalar-variable-list )
struct CUFReduction {
TUPLE_CLASS_BOILERPLATE(CUFReduction);
- using Operator = AccReductionOperator;
+ using Operator = ReductionOperator;
std::tuple<Operator, std::list<Scalar<Variable>>> t;
};
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index f130036d949d7..357a4c76d997b 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/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp
index b02e7be75d20f..4f5da8fb70eba 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");
@@ -1356,8 +1356,7 @@ genReductions(const Fortran::parser::AccObjectListWithReduction &objectList,
llvm::SmallVector<mlir::Attribute> &reductionRecipes) {
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);
+ const auto &op = 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 382a593416872..f703e09612d54 100644
--- a/flang/lib/Parser/executable-parsers.cpp
+++ b/flang/lib/Parser/executable-parsers.cpp
@@ -254,11 +254,15 @@ TYPE_PARSER(construct<ConcurrentControl>(name / "=", scalarIntExpr / ":",
// 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 (" >> Parser<LocalitySpec::Reduce::Operator>{} / ":",
+ listOfNames / ")")) ||
construct<LocalitySpec>(construct<LocalitySpec::Shared>(
"SHARED" >> parenthesized(listOfNames))) ||
construct<LocalitySpec>(
diff --git a/flang/lib/Parser/openacc-parsers.cpp b/flang/lib/Parser/openacc-parsers.cpp
index 3d919e29a2482..c78676664e0a3 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
@@ -92,20 +92,20 @@ TYPE_PARSER(
TYPE_PARSER(construct<AccCollapseArg>(
"FORCE:"_tok >> pure(true) || pure(false), scalarIntConstantExpr))
-// 2.5.15 Reduction
+// 2.5.15 Reduction, F'2023 R1131, and CUF reduction-op
// 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 bdd968b19a43f..b98aae8e8f7a2 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::ReductionOperator>(x.t));
+ Walk(":", std::get<std::list<parser::Name>>(x.t), ",", ")");
+ }
void Unparse(const LocalitySpec::Shared &x) {
Word("SHARED("), Walk(x.v, ", "), Put(')');
}
@@ -2018,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));
}
@@ -2753,28 +2757,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 c1eab090a4bb1..9a5ffcf0d24b6 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,6 +683,63 @@ class DoContext {
}
}
+ 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
+ for (const parser::Name &x : std::get<std::list<parser::Name>>(reduce.t)) {
+ bool supportedIdentifier{false};
+ if (x.symbol && x.symbol->GetType()) {
+ const auto *type{x.symbol->GetType()};
+ auto typeMismatch{[&](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);
+ }};
+ supportedIdentifier = 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))) {
+ typeMismatch("COMPLEX', 'INTEGER', or '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) {
+ typeMismatch("LOGICAL");
+ }
+ break;
+ case parser::ReductionOperator::Operator::Max:
+ case parser::ReductionOperator::Operator::Min:
+ if (!(type->IsNumeric(TypeCategory::Integer) ||
+ type->IsNumeric(TypeCategory::Real))) {
+ typeMismatch("INTEGER', or 'REAL");
+ }
+ break;
+ case parser::ReductionOperator::Operator::Iand:
+ case parser::ReductionOperator::Operator::Ior:
+ case parser::ReductionOperator::Operator::Ieor:
+ if (!type->IsNumeric(TypeCategory::Integer)) {
+ typeMismatch("INTEGER");
+ }
+ break;
+ default:
+ supportedIdentifier = false;
+ break;
+ }
+ }
+ if (!supportedIdentifier) {
+ context_.Say(currentStatementSourcePosition_,
+ "Invalid 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 +794,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 68cfc8641b9b2..8db7ee671306f 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
- // 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 &);
+ // 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,
@@ -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 &);
@@ -2254,18 +2258,20 @@ 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())
- .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(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()) {
- message.Attach(Message{*usedAsProc, "Referenced as a procedure"_en_US});
+ message.Attach(*usedAsProc, "Referenced as a procedure"_en_US);
}
}
}
@@ -5514,7 +5520,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);
@@ -6478,44 +6484,59 @@ 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
+ const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
+ bool isReduce{flag == Symbol::Flag::LocalityReduce};
+ const char *specName{
+ flag == Symbol::Flag::LocalityLocalInit ? "LOCAL_INIT" : "LOCAL"};
+ if (IsAllocatable(symbol) && !isReduce) { // F'2023 C1130
SayWithDecl(name, symbol,
- "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US);
+ "ALLOCATABLE variable '%s' not allowed in a %s locality-spec"_err_en_US,
+ specName);
return false;
}
- if (IsOptional(symbol)) { // C1128
+ 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
+ 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)) { // C1128
+ if (IsFinalizable(symbol) && !isReduce) { // F'2023 C1130
SayWithDecl(name, symbol,
- "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US);
+ "Finalizable variable '%s' not allowed in a %s locality-spec"_err_en_US,
+ specName);
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) { // F'2023 C1130
+ SayWithDecl(name, symbol,
+ "Coarray '%s' not allowed in a %s locality-spec"_err_en_US, specName);
return false;
}
if (const DeclTypeSpec * type{symbol.GetType()}) {
- if (type->IsPolymorphic() && IsDummy(symbol) &&
- !IsPointer(symbol)) { // C1128
+ if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&
+ !isReduce) { // F'2023 C1130
SayWithDecl(name, symbol,
- "Nonpointer polymorphic argument '%s' not allowed in a "
- "locality-spec"_err_en_US);
+ "Nonpointer polymorphic argument '%s' not allowed in a %s locality-spec"_err_en_US,
+ specName);
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)) { // F'2023 C1130-C1131
SayWithDecl(name, symbol,
"Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
return false;
@@ -6523,8 +6544,7 @@ bool DeclarationVisitor::PassesLocalityChecks(
if (std::optional<Message> whyNot{WhyNotDefinable(
name.source, currScope(), DefinabilityFlags{}, symbol)}) {
SayWithReason(name, symbol,
- "'%s' may not appear in a locality-spec because it is not "
- "definable"_err_en_US,
+ "'%s' may not appear in a locality-spec because it is not definable"_err_en_US,
std::move(*whyNot));
return false;
}
@@ -6544,12 +6564,14 @@ Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
return *prev;
}
-Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
+void DeclarationVisitor::DeclareLocalEntity(
+ const parser::Name &name, Symbol::Flag flag) {
Symbol &prev{FindOrDeclareEnclosingEntity(name)};
- if (!PassesLocalityChecks(name, prev)) {
- return nullptr;
+ if (PassesLocalityChecks(name, prev, flag)) {
+ if (auto *symbol{&MakeHostAssocSymbol(name, prev)}) {
+ symbol->set(flag);
+ }
}
- return &MakeHostAssocSymbol(name, prev);
}
Symbol *DeclarationVisitor::DeclareStatementEntity(
@@ -6886,18 +6908,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->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->set(Symbol::Flag::LocalityLocalInit);
- }
+ DeclareLocalEntity(name, Symbol::Flag::LocalityLocalInit);
+ }
+ return false;
+}
+
+bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {
+ for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
+ DeclareLocalEntity(name, Symbol::Flag::LocalityReduce);
}
return false;
}
@@ -6996,23 +7021,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;
}
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..ceab9d8e99218
--- /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' ('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
+end subroutine s2
+
+subroutine s3()
+! Cannot apply integer/logical operations to real variables
+ real :: r1, r2, r3, r4
+!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)
+ 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' ('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', or 'REAL').
+!ERROR: Reduction variable 'c5' ('COMPLEX(4)') does not have a suitable type ('INTEGER', or '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) &
+ & 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' ('LOGICAL(4)') does not have a suitable type ('COMPLEX', 'INTEGER', or 'REAL').
+!ERROR: Reduction variable 'l2' ('LOGICAL(4)') does not have a suitable type ('COMPLEX', 'INTEGER', or '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', or 'REAL').
+!ERROR: Reduction variable 'l7' ('LOGICAL(4)') does not have a suitable type ('INTEGER', or '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)
+ end do
+end subroutine s5
+
+subroutine s6()
+! Cannot reduce a character
+ character ch
+!ERROR: Reduction variable 'ch' ('CHARACTER(1_8,1)') does not have a suitable type ('COMPLEX', 'INTEGER', or 'REAL').
+ 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..0a40a19435748 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 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
More information about the flang-commits
mailing list