[flang-commits] [flang] f65e76d - [flang] Add semantic checks for intrinsic function REDUCE()
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Apr 25 12:38:01 PDT 2022
Author: Peter Klausler
Date: 2022-04-25T12:37:53-07:00
New Revision: f65e76d16df75ca504265bf404b0be74388f2b83
URL: https://github.com/llvm/llvm-project/commit/f65e76d16df75ca504265bf404b0be74388f2b83
DIFF: https://github.com/llvm/llvm-project/commit/f65e76d16df75ca504265bf404b0be74388f2b83.diff
LOG: [flang] Add semantic checks for intrinsic function REDUCE()
Support REDUCE's special semantic requirements in intrinsic
procedure semantics.
Differential Revision: https://reviews.llvm.org/D124296
Added:
flang/test/Semantics/reduce01.f90
Modified:
flang/lib/Evaluate/intrinsics.cpp
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 63a7f4e3fd213..5c0a2eaaf8a91 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -671,13 +671,15 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"reduce",
{{"array", SameType, Rank::array},
{"operation", SameType, Rank::reduceOperation}, RequiredDIM,
- OptionalMASK, {"identity", SameType, Rank::scalar},
+ OptionalMASK,
+ {"identity", SameType, Rank::scalar, Optionality::optional},
{"ordered", AnyLogical, Rank::scalar, Optionality::optional}},
SameType, Rank::dimReduced, IntrinsicClass::transformationalFunction},
{"reduce",
{{"array", SameType, Rank::array},
{"operation", SameType, Rank::reduceOperation}, MissingDIM,
- OptionalMASK, {"identity", SameType, Rank::scalar},
+ OptionalMASK,
+ {"identity", SameType, Rank::scalar, Optionality::optional},
{"ordered", AnyLogical, Rank::scalar, Optionality::optional}},
SameType, Rank::scalar, IntrinsicClass::transformationalFunction},
{"repeat", {{"string", SameChar, Rank::scalar}, {"ncopies", AnyInt}},
@@ -1600,10 +1602,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
argOk = rank == 0 || rank + 1 == arrayArg->Rank();
break;
case Rank::reduceOperation:
- // TODO: validate the reduction operation -- it must be a pure
- // function of two arguments with special constraints.
- CHECK(arrayArg);
- argOk = rank == 0;
+ // The reduction function is validated in ApplySpecificChecks().
+ argOk = true;
break;
case Rank::locReduced:
case Rank::rankPlus1:
@@ -2357,6 +2357,90 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
arg ? arg->sourceLocation() : context.messages().at(),
"Argument of PRESENT() must be the name of an OPTIONAL dummy argument"_err_en_US);
}
+ } else if (name == "reduce") { // 16.9.161
+ std::optional<DynamicType> arrayType;
+ if (const auto &array{call.arguments[0]}) {
+ arrayType = array->GetType();
+ }
+ std::optional<characteristics::Procedure> procChars;
+ parser::CharBlock at{context.messages().at()};
+ if (const auto &operation{call.arguments[1]}) {
+ if (const auto *expr{operation->UnwrapExpr()}) {
+ if (const auto *designator{
+ std::get_if<ProcedureDesignator>(&expr->u)}) {
+ procChars =
+ characteristics::Procedure::Characterize(*designator, context);
+ } else if (const auto *ref{std::get_if<ProcedureRef>(&expr->u)}) {
+ procChars = characteristics::Procedure::Characterize(*ref, context);
+ }
+ }
+ if (auto operationAt{operation->sourceLocation()}) {
+ at = *operationAt;
+ }
+ }
+ if (!arrayType || !procChars) {
+ ok = false; // error recovery
+ } else {
+ const auto *result{procChars->functionResult->GetTypeAndShape()};
+ if (!procChars->IsPure() || procChars->dummyArguments.size() != 2 ||
+ !procChars->functionResult) {
+ ok = false;
+ context.messages().Say(at,
+ "OPERATION= argument of REDUCE() must be a pure function of two data arguments"_err_en_US);
+ } else if (!result || result->Rank() != 0) {
+ ok = false;
+ context.messages().Say(at,
+ "OPERATION= argument of REDUCE() must be a scalar function"_err_en_US);
+ } else if (result->type().IsPolymorphic() ||
+ result->type() != *arrayType) {
+ ok = false;
+ context.messages().Say(at,
+ "OPERATION= argument of REDUCE() must have the same type as ARRAY="_err_en_US);
+ } else {
+ const characteristics::DummyDataObject *data[2]{};
+ for (int j{0}; j < 2; ++j) {
+ const auto &dummy{procChars->dummyArguments.at(j)};
+ data[j] = std::get_if<characteristics::DummyDataObject>(&dummy.u);
+ ok = ok && data[j];
+ }
+ if (!ok) {
+ context.messages().Say(at,
+ "OPERATION= argument of REDUCE() may not have dummy procedure arguments"_err_en_US);
+ } else {
+ for (int j{0}; j < 2; ++j) {
+ ok = ok &&
+ !data[j]->attrs.test(
+ characteristics::DummyDataObject::Attr::Optional) &&
+ !data[j]->attrs.test(
+ characteristics::DummyDataObject::Attr::Allocatable) &&
+ !data[j]->attrs.test(
+ characteristics::DummyDataObject::Attr::Pointer) &&
+ data[j]->type.Rank() == 0 &&
+ !data[j]->type.type().IsPolymorphic() &&
+ data[j]->type.type() == *arrayType;
+ }
+ if (!ok) {
+ context.messages().Say(at,
+ "Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional"_err_en_US);
+ } else if (data[0]->attrs.test(characteristics::DummyDataObject::
+ Attr::Asynchronous) !=
+ data[1]->attrs.test(
+ characteristics::DummyDataObject::Attr::Asynchronous) ||
+ data[0]->attrs.test(
+ characteristics::DummyDataObject::Attr::Volatile) !=
+ data[1]->attrs.test(
+ characteristics::DummyDataObject::Attr::Volatile) ||
+ data[0]->attrs.test(
+ characteristics::DummyDataObject::Attr::Target) !=
+ data[1]->attrs.test(
+ characteristics::DummyDataObject::Attr::Target)) {
+ ok = false;
+ context.messages().Say(at,
+ "If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VOLATILE, or TARGET attribute, both must have that attribute"_err_en_US);
+ }
+ }
+ }
+ }
}
return ok;
}
diff --git a/flang/test/Semantics/reduce01.f90 b/flang/test/Semantics/reduce01.f90
new file mode 100644
index 0000000000000..9e6fffcc091f0
--- /dev/null
+++ b/flang/test/Semantics/reduce01.f90
@@ -0,0 +1,75 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+ contains
+ impure real function f1(x,y)
+ f1 = x + y
+ end function
+ pure function f2(x,y)
+ real :: f2(1)
+ real, intent(in) :: x, y
+ f2(1) = x + y
+ end function
+ pure real function f3(x,y,z)
+ real, intent(in) :: x, y, z
+ f3 = x + y + z
+ end function
+ pure real function f4(x,y)
+ interface
+ pure real function x(); end function
+ pure real function y(); end function
+ end interface
+ f4 = x() + y()
+ end function
+ pure integer function f5(x,y)
+ real, intent(in) :: x, y
+ f5 = x + y
+ end function
+ pure real function f6(x,y)
+ real, intent(in) :: x(*), y(*)
+ f6 = x(1) + y(1)
+ end function
+ pure real function f7(x,y)
+ real, intent(in), allocatable :: x
+ real, intent(in) :: y
+ f7 = x + y
+ end function
+ pure real function f8(x,y)
+ real, intent(in), pointer :: x
+ real, intent(in) :: y
+ f8 = x + y
+ end function
+ pure real function f9(x,y)
+ real, intent(in), optional :: x
+ real, intent(in) :: y
+ f9 = x + y
+ end function
+ pure real function f10(x,y)
+ real, intent(in), target :: x
+ real, intent(in) :: y
+ f10 = x + y
+ end function
+
+ subroutine test
+ real :: a(10,10), b
+ !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
+ b = reduce(a, f1)
+ !ERROR: OPERATION= argument of REDUCE() must be a scalar function
+ b = reduce(a, f2)
+ !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments
+ b = reduce(a, f3)
+ !ERROR: OPERATION= argument of REDUCE() may not have dummy procedure arguments
+ b = reduce(a, f4)
+ !ERROR: OPERATION= argument of REDUCE() must have the same type as ARRAY=
+ b = reduce(a, f5)
+ !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
+ b = reduce(a, f6)
+ !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
+ b = reduce(a, f7)
+ !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
+ b = reduce(a, f8)
+ !ERROR: Arguments of OPERATION= procedure of REDUCE() must be both scalar of the same type as ARRAY=, and neither allocatable, pointer, polymorphic, or optional
+ b = reduce(a, f9)
+ !ERROR: If either argument of the OPERATION= procedure of REDUCE() has the ASYNCHRONOUS, VOLATILE, or TARGET attribute, both must have that attribute
+ b = reduce(a, f10)
+ end subroutine
+end module
More information about the flang-commits
mailing list