[flang] Take character function length into account when testing compatibility

When a character-valued function is passed as an actual argument, and both
the actual function and the dummy argument have explicit result lengths, take them
into account when testing for compatibility.

Differential Revision: https://reviews.llvm.org/D139129

diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 25a4279..0b22e8d 100644 (file)
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -921,7 +921,7 @@ bool FunctionResult::IsCompatibleWith(
         if (whyNot) {
           *whyNot = "function results have distinct constant extents";
         }
-      } else if (!ifaceTypeShape->type().IsTkCompatibleWith(
+      } else if (!ifaceTypeShape->type().IsTkLenCompatibleWith(
                      actualTypeShape->type())) {
         if (whyNot) {
           *whyNot = "function results have incompatible types: "s +

diff --git a/flang/test/Semantics/call25.f90 b/flang/test/Semantics/call25.f90
index 7ef6beb..701bafe 100644 (file)
--- a/flang/test/Semantics/call25.f90
+++ b/flang/test/Semantics/call25.f90
@@ -13,6 +13,10 @@ module m
     character(5), intent(in) :: x
     explicitLength = x
   end function
+  character(6) function badExplicitLength(x)
+    character(5), intent(in) :: x
+    badExplicitLength = x
+  end function
   real function notChar(x)
     character(*), intent(in) :: x
     notChar = 0
@@ -34,6 +38,8 @@ program main
   external assumedlength
   character(5) :: assumedlength
   call subr1(explicitLength)
+  !CHECK: error: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
+  call subr1(badExplicitLength)
   call subr1(assumedLength)
   !CHECK: error: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
   call subr1(notChar)
@@ -42,6 +48,9 @@ program main
   !CHECK: error: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
   call subr2(notChar)
   call subr3(explicitLength)
+  !CHECK: warning: If the procedure's interface were explicit, this reference would be in error
+  !CHECK: because: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
+  call subr3(badExplicitLength)
   call subr3(assumedLength)
   !CHECK: warning: If the procedure's interface were explicit, this reference would be in error
   !CHECK: because: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type