[flang] most call04 checks

Original-commit: flang-compiler/f18@65289a66d1
Reviewed-on: https://github.com/flang-compiler/f18/pull/783
Tree-same-pre-rewrite: false

flang/lib/semantics/check-call.cc

@@ -264,6 +264,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           dummyName);
     }
   }
+  if (actualLastObject && actualLastObject->IsCoarray() &&
+      IsAllocatable(*actualLastSymbol) &&
+      dummy.intent == common::Intent::Out) {  // C846
+    messages.Say(
+        "ALLOCATABLE coarray '%s' may not be associated with INTENT(OUT) %s"_err_en_US,
+        actualLastSymbol->name(), dummyName);
+  }
 
   // definability
   const char *reason{nullptr};

flang/lib/semantics/check-declarations.cc

@@ -88,24 +88,24 @@ void CheckHelper::Check(Symbol &symbol) {
   }
   if (IsAssumedLengthCharacterFunction(symbol)) {  // C723
     if (symbol.attrs().test(Attr::RECURSIVE)) {
-      context_.Say(
+      messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
     }
     if (symbol.Rank() > 0) {
-      context_.Say(
+      messages_.Say(
           "An assumed-length CHARACTER(*) function cannot return an array"_err_en_US);
     }
     if (symbol.attrs().test(Attr::PURE)) {
-      context_.Say(
+      messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
     }
     if (symbol.attrs().test(Attr::ELEMENTAL)) {
-      context_.Say(
+      messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
     }
     if (const Symbol * result{FindFunctionResult(symbol)}) {
       if (result->attrs().test(Attr::POINTER)) {
-        context_.Say(
+        messages_.Say(
             "An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
       }
     }
@@ -113,6 +113,21 @@ void CheckHelper::Check(Symbol &symbol) {
   if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
     Check(object->shape());
     Check(object->coshape());
+    if (object->isDummy() && symbol.attrs().test(Attr::INTENT_OUT)) {
+      if (const auto *type{object->type()}) {
+        if (const auto *derived{type->AsDerived()}) {
+          TypeInspector inspector;
+          inspector.Inspect(*derived);
+          if (const Symbol * bad{inspector.allocatableCoarray()}) {  // C846
+            if (auto *msg{messages_.Say(
+                    "An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray"_err_en_US)}) {
+              msg->Attach(
+                  bad->name(), "Declaration of ALLOCATABLE coarray"_en_US);
+            }
+          }
+        }
+      }
+    }
   }
 }
 

flang/test/semantics/CMakeLists.txt

@@ -171,6 +171,7 @@ set(ERROR_TESTS
   call01.f90
   call02.f90
   call03.f90
+  call04.f90
   call13.f90
 )
 

flang/test/semantics/call04.f90

@@ -35,27 +35,27 @@ module m
     real, allocatable, intent(out) :: x(:)
   end subroutine
   subroutine s01b ! C846 - can only be caught at a call via explicit interface
-    !ERROR: An allocatable coarray cannot be associated with an INTENT(OUT) dummy argument
+    !ERROR: ALLOCATABLE coarray 'coarray' may not be associated with INTENT(OUT) dummy argument 'x='
     call s01a(coarray)
   end subroutine
 
   subroutine s02(x) ! C846
-    !ERROR: An INTENT(OUT) argument must not contain an allocatable coarray
+    !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray
     type(hasCoarray), intent(out) :: x
   end subroutine
 
   subroutine s03(x) ! C846
-    !ERROR: An INTENT(OUT) argument must not contain an allocatable coarray
+    !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray
     type(extendsHasCoarray), intent(out) :: x
   end subroutine
 
   subroutine s04(x) ! C846
-    !ERROR: An INTENT(OUT) argument must not contain an allocatable coarray
+    !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray
     type(hasCoarray2), intent(out) :: x
   end subroutine
 
   subroutine s05(x) ! C846
-    !ERROR: An INTENT(OUT) argument must not contain an allocatable coarray
+    !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray
     type(extendsHasCoarray2), intent(out) :: x
   end subroutine
 
@@ -63,12 +63,12 @@ end module
 
 subroutine s06(x) ! C847
   use ISO_FORTRAN_ENV, only: lock_type
-  !ERROR: A dummy argument of TYPE(LOCK_TYPE) cannot be INTENT(OUT)
+  !ERROR: A dummy argument of TYPE(LOCK_TYPE) may not be INTENT(OUT)
   type(lock_type), intent(out) :: x
 end subroutine
 
 subroutine s07(x) ! C847
   use ISO_FORTRAN_ENV, only: event_type
-  !ERROR: A dummy argument of TYPE(EVENT_TYPE) cannot be INTENT(OUT)
+  !ERROR: A dummy argument of TYPE(EVENT_TYPE) may not be INTENT(OUT)
   type(event_type), intent(out) :: x
 end subroutine