[flang] Stricter scrutiny of MOVE_ALLOC calls

[klausler]

Summary

Enforce remaining semantic restrictions on the arguments to MOVE_ALLOC,
namely that the first two arguments must be allocatable (!) and that
if the source is polymorphic, so must the destination be.

[klausler]

Resolve merge conflict better in test case.

flang/lib/Evaluate/intrinsics.cpp

if (name == "allocated") {
     ok =
         arg && (arg->GetAssumedTypeDummy() || GetLastSymbol(arg->UnwrapExpr()));
     if (!ok) {
       context.messages().Say(
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of LOC() must be an object or procedure"_err_en_US);
     }
   } else if (name == "move_alloc") {
-    bool fromOk{
-        CheckForCoindexedObject(context, call.arguments[0], name, "from")};
-    bool toOk{CheckForCoindexedObject(context, call.arguments[1], name, "to")};
-    bool statOk{
-        CheckForCoindexedObject(context, call.arguments[2], name, "stat")};
-    bool errmsgOk{
-        CheckForCoindexedObject(context, call.arguments[3], name, "errmsg")};
-    ok = fromOk && toOk && statOk && errmsgOk;
+    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) {
       if (const auto *expr{arg->UnwrapExpr()}) {
         if (const Symbol * symbol{UnwrapWholeSymbolDataRef(*expr)}) {
           ok = symbol->attrs().test(semantics::Attr::OPTIONAL);
         }
       }

flang/test/Semantics/move_alloc.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Check for semantic errors in move_alloc() subroutine calls
 program main
-  integer, allocatable :: a(:)[:], b(:)[:], c(:)[:], d(:)[:]
+  integer, allocatable :: a(:)[:], b(:)[:], c(:)[:], d(:)[:], f(:)
   !ERROR: 'e' is an ALLOCATABLE coarray and must have a deferred coshape
   integer, allocatable :: e(:)[*]
   integer status, coindexed_status[*]
   character(len=1) message, coindexed_message[*]
+  integer :: nonAllocatable(10)
+  type t
+  end type
+  class(t), allocatable :: t1
+  type(t), allocatable :: t2
 
   ! standards conforming
   allocate(a(3)[*])
   a = [ 1, 2, 3 ]
   call move_alloc(a, b, status, message)
 
   allocate(c(3)[*])
   c = [ 1, 2, 3 ]
program main
   call move_alloc(c, d, errmsg=message, stat=coindexed_status[1])
 
   !ERROR: 'from' argument to 'move_alloc' may not be a coindexed object
   !ERROR: 'to' argument to 'move_alloc' may not be a coindexed object
   !ERROR: 'stat' argument to 'move_alloc' may not be a coindexed object
   !ERROR: 'errmsg' argument to 'move_alloc' may not be a coindexed object
   call move_alloc(c[1], d[1], stat=coindexed_status[1], errmsg=coindexed_message[1])
 
+  !ERROR: Argument #1 to MOVE_ALLOC must be allocatable
+  call move_alloc(nonAllocatable, f)
+  !ERROR: Argument #2 to MOVE_ALLOC must be allocatable
+  call move_alloc(f, nonAllocatable)
+
+  !ERROR: When MOVE_ALLOC(FROM=) is polymorphic, TO= must also be polymorphic
+  call move_alloc(t1, t2)
+  call move_alloc(t2, t1) ! ok
+
 end program main