[flang] Fix check for coarray actual passed to implicit interface

[klausler]

The check for a coarray actual argument being passed to a procedure with an implicit interface was incorrect, yielding false positives for coindexed objects. Fix.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

The check for a coarray actual argument being passed to a procedure with an implicit interface was incorrect, yielding false positives for coindexed objects. Fix.

---

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

3 Files Affected:

• (modified) flang/lib/Evaluate/tools.cpp (+1-1)
• (modified) flang/lib/Semantics/check-call.cpp (+5-4)
• (modified) flang/test/Semantics/call13.f90 (+2-1)

diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 2d0e1996632fc2..cd17098287620c 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -908,7 +908,7 @@ bool IsAssumedRank(const ActualArgument &arg) {
 
 int GetCorank(const ActualArgument &arg) {
   const auto *expr{arg.UnwrapExpr()};
-  return GetCorank(*expr);
+  return expr ? GetCorank(*expr) : 0;
 }
 
 bool IsProcedureDesignator(const Expr<SomeType> &expr) {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ba68a0f898d469..6e4ef4946db21f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -67,10 +67,6 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
           "Null pointer argument requires an explicit interface"_err_en_US);
     } else if (auto named{evaluate::ExtractNamedEntity(*expr)}) {
       const Symbol &symbol{named->GetLastSymbol()};
-      if (symbol.Corank() > 0) {
-        messages.Say(
-            "Coarray argument requires an explicit interface"_err_en_US);
-      }
       if (evaluate::IsAssumedRank(symbol)) {
         messages.Say(
             "Assumed rank argument requires an explicit interface"_err_en_US);
@@ -106,6 +102,11 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
       }
     }
   }
+  if (int corank{GetCorank(arg)}; corank > 0) {
+    messages.Say(
+        "Argument with corank %d requires an explicit interface"_err_en_US,
+        corank);
+  }
 }
 
 // F'2023 15.5.2.12p1: "Sequence association only applies when the dummy
diff --git a/flang/test/Semantics/call13.f90 b/flang/test/Semantics/call13.f90
index 8b203e4b715d50..e58e3a4d2e3cb2 100644
--- a/flang/test/Semantics/call13.f90
+++ b/flang/test/Semantics/call13.f90
@@ -22,8 +22,9 @@ subroutine s(assumedRank, coarray, class, classStar, typeStar)
   call implicit10(1, 2, keyword=3)  ! 15.4.2.2(1)
   !ERROR: Assumed rank argument requires an explicit interface
   call implicit11(assumedRank)  ! 15.4.2.2(3)(c)
-  !ERROR: Coarray argument requires an explicit interface
+  !ERROR: Argument with corank 1 requires an explicit interface
   call implicit12(coarray)  ! 15.4.2.2(3)(d)
+  call implicit12a(coarray[1]) ! ok
   !ERROR: Parameterized derived type actual argument requires an explicit interface
   call implicit13(pdtx)  ! 15.4.2.2(3)(e)
   call implicit14(class)  ! ok

[akuhlens]

Should we turn things like this into a pedantic warning?

[klausler]

Should we turn things like this into a pedantic warning?

There's nothing wrong with this usage.