[flang-commits] [flang] 9114ce4 - [flang] Take character function length into account when testing compatibility

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-12-03T12:35:23-08:00
New Revision: 9114ce4d1da94da82e1528cd0fa0500c14169c8e

URL: https://github.com/llvm/llvm-project/commit/9114ce4d1da94da82e1528cd0fa0500c14169c8e
DIFF: https://github.com/llvm/llvm-project/commit/9114ce4d1da94da82e1528cd0fa0500c14169c8e.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Evaluate/characteristics.cpp
    flang/test/Semantics/call25.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 25a427914b5cb..0b22e8de8267c 100644
--- 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 7ef6beb6adf7c..701bafe62966c 100644
--- a/flang/test/Semantics/call25.f90
+++ b/flang/test/Semantics/call25.f90
@@ -13,6 +13,10 @@ character(5) function explicitLength(x)
     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