diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -812,13 +812,23 @@ } } -// The actual argument arrays to an ELEMENTAL procedure must conform. +// 15.8.1(3) -- In a reference to an elemental procedure, if any argument is an +// array, each actual argument that corresponds to an INTENT(OUT) or +// INTENT(INOUT) dummy argument shall be an array. The actual argument to an +// ELEMENTAL procedure must conform. static bool CheckElementalConformance(parser::ContextualMessages &messages, const characteristics::Procedure &proc, evaluate::ActualArguments &actuals, evaluate::FoldingContext &context) { std::optional shape; std::string shapeName; int index{0}; + bool hasArrayArg{false}; + for (const auto &arg : actuals) { + if (arg && arg.value().Rank() > 0) { + hasArrayArg = true; + break; + } + } for (const auto &arg : actuals) { const auto &dummy{proc.dummyArguments.at(index++)}; if (arg) { @@ -839,6 +849,12 @@ shape = std::move(argShape); shapeName = argName; } + } else if ((dummy.GetIntent() == common::Intent::Out || + dummy.GetIntent() == common::Intent::InOut) && + hasArrayArg) { + messages.Say( + "In an elemental procedure with at least one array arugment, actual argument %s that corresponds to an INTENT(OUT) or INTENT(INOUT) dummay argument must be an array"_err_en_US, + expr->AsFortran()); } } } diff --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90 --- a/flang/test/Semantics/call02.f90 +++ b/flang/test/Semantics/call02.f90 @@ -123,3 +123,20 @@ !ERROR: No explicit type declared for 'index' call s1(index) end + +subroutine p05 + integer :: a1(2), a2, a3 + + !ERROR: In an elemental procedure with at least one array arugment, actual argument a2 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummay argument must be an array + !ERROR: In an elemental procedure with at least one array arugment, actual argument a3 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummay argument must be an array + call s1(a1, a2, a3) +contains + elemental subroutine s1(a, b, c) + integer, intent(in) :: a + integer, intent(out) :: b + integer, intent(inout) :: c + b = a + c = a + end +end +