[flang] Add one semantic check for elemental call arguments

[peixin]

Summary

As Fortran 2018 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. Add
this semantic check.

[klausler]

flang/lib/Semantics/check-call.cpp

897

The original name was fine.

[peixin]

Thanks @klausler for the review. Change the function name back to CheckElementalConformance as suggested.

flang/lib/Semantics/check-call.cpp

for (auto &bad : kwArgs) {
       evaluate::ActualArgument &x{bad.second};
       messages.Say(*x.keyword(),
           "Argument keyword '%s=' is not recognized for this procedure reference"_err_en_US,
           *x.keyword());
     }
   }
 }
 
-// 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<evaluate::Shape> 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) {
       if (const auto *expr{arg->UnwrapExpr()}) {
         if (auto argShape{evaluate::GetShape(context, *expr)}) {
           if (GetRank(*argShape) > 0) {
             std::string argName{"actual argument ("s + expr->AsFortran() +
                 ") corresponding to dummy argument #" + std::to_string(index) +
                 " ('" + dummy.name + "')"};
             if (shape) {
               auto tristate{evaluate::CheckConformance(messages, *shape,
                   *argShape, evaluate::CheckConformanceFlags::None,
                   shapeName.c_str(), argName.c_str())};
               if (tristate && !*tristate) {
                 return false;
               }
             } else {
               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());
           }
         }
       }
     }
   }
   return true;
 }
 
for (auto &actual : actuals) {
           messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
                        "associated with an actual argument in this procedure "
                        "reference"_err_en_US,
               dummy.name, index);
         }
       }
     }
     if (proc.IsElemental() && !buffer.AnyFatalError()) {
       CheckElementalConformance(messages, proc, actuals, localContext);
     }
   }
   return buffer;
 }
 
 parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
     const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {

flang/test/Semantics/call02.f90

contains
   end
 end
 
 subroutine p04
   implicit none
   !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
+