[flang] Fix semantic checks for MOVE_ALLOC (#77362)

The checking of calls to the intrinsic subroutine MOVE_ALLOC is not
insisting that its first two arguments be whole allocatable variables or
components. Fix, move the code into check-calls.cpp (a better home for
such things), and clean up the tests.

Fixes https://github.com/llvm/llvm-project/issues/77230.

1 files changed, 14 insertions, 48 deletions

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 08cec73..da6d5970 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2727,28 +2727,13 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
   }
 }
 
-static bool CheckForCoindexedObject(FoldingContext &context,
-    const std::optional<ActualArgument> &arg, const std::string &procName,
-    const std::string &argName) {
-  bool ok{true};
-  if (arg) {
-    if (ExtractCoarrayRef(arg->UnwrapExpr())) {
-      ok = false;
-      context.messages().Say(arg->sourceLocation(),
-          "'%s' argument to '%s' may not be a coindexed object"_err_en_US,
-          argName, procName);
-    }
-  }
-  return ok;
-}
-
 // Function C_LOC(X) from intrinsic module ISO_C_BINDING (18.2.3.6)
 std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
     ActualArguments &arguments, FoldingContext &context) const {
   static const char *const keywords[]{"x", nullptr};
   if (CheckAndRearrangeArguments(arguments, context.messages(), keywords)) {
     CHECK(arguments.size() == 1);
-    CheckForCoindexedObject(context, arguments[0], "c_loc", "x");
+    CheckForCoindexedObject(context.messages(), arguments[0], "c_loc", "x");
     const auto *expr{arguments[0].value().UnwrapExpr()};
     if (expr &&
         !(IsObjectPointer(*expr) ||
@@ -2876,7 +2861,7 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
   }
 
   return sameType &&
-      CheckForCoindexedObject(context, statArg, procName, "stat");
+      CheckForCoindexedObject(context.messages(), statArg, procName, "stat");
 }
 
 // Applies any semantic checks peculiar to an intrinsic.
@@ -2900,25 +2885,29 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
     // Now handled in Semantics/check-call.cpp
   } else if (name == "atomic_and" || name == "atomic_or" ||
       name == "atomic_xor") {
-    return CheckForCoindexedObject(context, call.arguments[2], name, "stat");
+    return CheckForCoindexedObject(
+        context.messages(), call.arguments[2], name, "stat");
   } else if (name == "atomic_cas") {
-    return CheckForCoindexedObject(context, call.arguments[4], name, "stat");
+    return CheckForCoindexedObject(
+        context.messages(), call.arguments[4], name, "stat");
   } else if (name == "atomic_define") {
     return CheckAtomicDefineAndRef(
         context, call.arguments[0], call.arguments[1], call.arguments[2], name);
   } else if (name == "atomic_fetch_add" || name == "atomic_fetch_and" ||
       name == "atomic_fetch_or" || name == "atomic_fetch_xor") {
-    return CheckForCoindexedObject(context, call.arguments[3], name, "stat");
+    return CheckForCoindexedObject(
+        context.messages(), call.arguments[3], name, "stat");
   } else if (name == "atomic_ref") {
     return CheckAtomicDefineAndRef(
         context, call.arguments[1], call.arguments[0], call.arguments[2], name);
   } else if (name == "co_broadcast" || name == "co_max" || name == "co_min" ||
       name == "co_sum") {
-    bool aOk{CheckForCoindexedObject(context, call.arguments[0], name, "a")};
-    bool statOk{
-        CheckForCoindexedObject(context, call.arguments[2], name, "stat")};
-    bool errmsgOk{
-        CheckForCoindexedObject(context, call.arguments[3], name, "errmsg")};
+    bool aOk{CheckForCoindexedObject(
+        context.messages(), call.arguments[0], name, "a")};
+    bool statOk{CheckForCoindexedObject(
+        context.messages(), call.arguments[2], name, "stat")};
+    bool errmsgOk{CheckForCoindexedObject(
+        context.messages(), call.arguments[3], name, "errmsg")};
     ok = aOk && statOk && errmsgOk;
   } else if (name == "image_status") {
     if (const auto &arg{call.arguments[0]}) {
@@ -2935,29 +2924,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of LOC() must be an object or procedure"_err_en_US);
     }
-  } else if (name == "move_alloc") {
-    ok &= CheckForCoindexedObject(context, call.arguments[0], name, "from");
-    ok &= CheckForCoindexedObject(context, call.arguments[1], name, "to");
-    ok &= CheckForCoindexedObject(context, call.arguments[2], name, "stat");
-    ok &= CheckForCoindexedObject(context, call.arguments[3], name, "errmsg");
-    if (call.arguments[0] && call.arguments[1]) {
-      for (int j{0}; j < 2; ++j) {
-        if (const Symbol *last{GetLastSymbol(call.arguments[j])};
-            last && !IsAllocatable(last->GetUltimate())) {
-          context.messages().Say(call.arguments[j]->sourceLocation(),
-              "Argument #%d to MOVE_ALLOC must be allocatable"_err_en_US,
-              j + 1);
-          ok = false;
-        }
-      }
-      auto type0{call.arguments[0]->GetType()};
-      auto type1{call.arguments[1]->GetType()};
-      if (type0 && type1 && type0->IsPolymorphic() && !type1->IsPolymorphic()) {
-        context.messages().Say(call.arguments[1]->sourceLocation(),
-            "When MOVE_ALLOC(FROM=) is polymorphic, TO= must also be polymorphic"_err_en_US);
-        ok = false;
-      }
-    }
   } else if (name == "present") {
     const auto &arg{call.arguments[0]};
     if (arg) {