[flang] Check actual/dummy coranks in more cases

[klausler]

The check for equality of actual and dummy argument coranks was taking place only for ALLOCATABLE coarrays; perform the check for all cases, and refine the ALLOCATABLE check to apply only to cases that don't fail the new more general check.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

The check for equality of actual and dummy argument coranks was taking place only for ALLOCATABLE coarrays; perform the check for all cases, and refine the ALLOCATABLE check to apply only to cases that don't fail the new more general check.

---

Full diff: https://github.com/llvm/llvm-project/pull/130167.diff

3 Files Affected:

• (modified) flang/lib/Semantics/check-call.cpp (+10-6)
• (modified) flang/test/Semantics/call04.f90 (+1-1)
• (modified) flang/test/Semantics/call06.f90 (+2-2)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ecc1e3d27e3bf..2ace461c8ff5c 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -790,6 +790,12 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
             "ALLOCATABLE %s must have INTENT(IN) to be associated with a coindexed actual argument"_err_en_US,
             dummyName);
       }
+      if (!actualIsCoindexed && actualLastSymbol && dummy.type.corank() == 0 &&
+          actualLastSymbol->Corank() > 0) {
+        messages.Say(
+            "ALLOCATABLE %s is not a coarray but actual argument has corank %d"_err_en_US,
+            dummyName, actualLastSymbol->Corank());
+      }
     } else if (evaluate::IsBareNullPointer(&actual)) {
       if (dummyIsOptional) {
       } else if (dummy.intent == common::Intent::Default &&
@@ -822,12 +828,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           "ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US,
           dummyName);
     }
-    if (!actualIsCoindexed && actualLastSymbol &&
-        actualLastSymbol->Corank() != dummy.type.corank()) {
-      messages.Say(
-          "ALLOCATABLE %s has corank %d but actual argument has corank %d"_err_en_US,
-          dummyName, dummy.type.corank(), actualLastSymbol->Corank());
-    }
   }
 
   // 15.5.2.7 -- dummy is POINTER
@@ -926,6 +926,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
       messages.Say(
           "Actual argument associated with coarray %s must be a coarray"_err_en_US,
           dummyName);
+    } else if (actualType.corank() != dummy.type.corank()) {
+      messages.Say(
+          "%s has corank %d but actual argument has corank %d"_err_en_US,
+          dummyName, dummy.type.corank(), actualType.corank());
     }
     if (dummyIsVolatile) {
       if (!actualIsVolatile) {
diff --git a/flang/test/Semantics/call04.f90 b/flang/test/Semantics/call04.f90
index 3b079aa4fb2b1..8a99ceee6b637 100644
--- a/flang/test/Semantics/call04.f90
+++ b/flang/test/Semantics/call04.f90
@@ -26,7 +26,7 @@ subroutine s01c(x)
   end subroutine
   subroutine s01b ! C846 - can only be caught at a call via explicit interface
     !ERROR: ALLOCATABLE coarray 'coarray' may not be associated with INTENT(OUT) dummy argument 'x='
-    !ERROR: ALLOCATABLE dummy argument 'x=' has corank 0 but actual argument has corank 1
+    !ERROR: ALLOCATABLE dummy argument 'x=' is not a coarray but actual argument has corank 1
     call s01a(coarray)
     call s01c(coarray) ! ok, dummy is not allocatable
   end subroutine
diff --git a/flang/test/Semantics/call06.f90 b/flang/test/Semantics/call06.f90
index 3e3c5aa61b570..99da70b64b10b 100644
--- a/flang/test/Semantics/call06.f90
+++ b/flang/test/Semantics/call06.f90
@@ -41,9 +41,9 @@ subroutine test(x)
     call s01(allofunc()) ! subtle: ALLOCATABLE function result isn't
     call s02(cov) ! ok
     call s03(com) ! ok
-    !ERROR: ALLOCATABLE dummy argument 'x=' has corank 1 but actual argument has corank 2
+    !ERROR: dummy argument 'x=' has corank 1 but actual argument has corank 2
     call s02(com)
-    !ERROR: ALLOCATABLE dummy argument 'x=' has corank 2 but actual argument has corank 1
+    !ERROR: dummy argument 'x=' has corank 2 but actual argument has corank 1
     call s03(cov)
     call s04(cov[1]) ! ok
     !ERROR: ALLOCATABLE dummy argument 'x=' must have INTENT(IN) to be associated with a coindexed actual argument

[klausler]

I need to refine this patch a bit more; Fortran actually doesn't require corank conformability for non-allocatable non-pointer arguments. Will update.