[flang-commits] [flang] [flang] Reduce implicit interface compatibility warnings due to length (PR #69385)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/69385

When a procedure with an implicit interface is called from two call sites with distinct argument types, we emit a warning.  This can lead to a lot of output when the actual argument types are differing-length character, and the warnings are less important since the procedure may well have been defined with assumed-length character dummy arguments. So let cases like CALL MYERROR('ab'); CALL MYERROR('abc') slide by without a warning.

>From e22021418a8535fc159a0af4cde96b776b51b885 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 17 Oct 2023 13:21:51 -0700
Subject: [PATCH] [flang] Reduce implicit interface compatibility warnings due
 to length

When a procedure with an implicit interface is called from two call
sites with distinct argument types, we emit a warning.  This can lead
to a lot of output when the actual argument types are differing-length
character, and the warnings are less important since the procedure may
well have been defined with assumed-length character dummy arguments.
So let cases like CALL MYERROR('ab'); CALL MYERROR('abc') slide by
without a warning.
---
 flang/lib/Evaluate/characteristics.cpp | 13 +++++++++++--
 flang/test/Semantics/call35.f90        |  2 ++
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index ac61e72f428a97e..3074fc0516b46af 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -300,7 +300,15 @@ bool DummyDataObject::IsCompatibleWith(
     }
     return false;
   }
-  if (!type.type().IsTkLenCompatibleWith(actual.type.type())) {
+  // Treat deduced dummy character type as if it were assumed-length character
+  // to avoid useless "implicit interfaces have distinct type" warnings from
+  // CALL FOO('abc'); CALL FOO('abcd').
+  bool deducedAssumedLength{type.type().category() == TypeCategory::Character &&
+      attrs.test(Attr::DeducedFromActual)};
+  bool compatibleTypes{deducedAssumedLength
+          ? type.type().IsTkCompatibleWith(actual.type.type())
+          : type.type().IsTkLenCompatibleWith(actual.type.type())};
+  if (!compatibleTypes) {
     if (whyNot) {
       *whyNot = "incompatible dummy data object types: "s +
           type.type().AsFortran() + " vs " + actual.type.type().AsFortran();
@@ -314,7 +322,8 @@ bool DummyDataObject::IsCompatibleWith(
     }
     return false;
   }
-  if (type.type().category() == TypeCategory::Character) {
+  if (type.type().category() == TypeCategory::Character &&
+      !deducedAssumedLength) {
     if (actual.type.type().IsAssumedLengthCharacter() !=
         type.type().IsAssumedLengthCharacter()) {
       if (whyNot) {
diff --git a/flang/test/Semantics/call35.f90 b/flang/test/Semantics/call35.f90
index ddcd64cec6c4341..ff819481226d628 100644
--- a/flang/test/Semantics/call35.f90
+++ b/flang/test/Semantics/call35.f90
@@ -1,11 +1,13 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
 subroutine s1
   call ext(1, 2)
+  call myerror('abc')
 end
 
 subroutine s2
   !WARNING: Reference to the procedure 'ext' has an implicit interface that is distinct from another reference: distinct numbers of dummy arguments
   call ext(1.)
+  call myerror('abcd') ! don't warn about distinct lengths
 end
 
 subroutine s3