[flang-commits] [flang] b70f507 - [flang] Fix folding of LEN(f(...))

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-06-29T10:25:07-07:00
New Revision: b70f507c75ac327eba895a970b507467a325f03b

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

LOG: [flang] Fix folding of LEN(f(...))

LEN(f(...)), where "f" is a non-intrinsic function, should not be folded
to anything else unless the result is a known constant value.  While there
are conceivable cases in which we could do better (e.g., an internal function
whose length is a host-associated INTENT(IN) dummy argument), there are
other cases that we're getting wrong.

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

Added: 
    

Modified: 
    flang/lib/Evaluate/call.cpp
    flang/lib/Evaluate/variable.cpp
    flang/test/Evaluate/rewrite01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp
index 75bc3939c00ee..39ca949b066f0 100644
--- a/flang/lib/Evaluate/call.cpp
+++ b/flang/lib/Evaluate/call.cpp
@@ -10,6 +10,7 @@
 #include "flang/Common/Fortran.h"
 #include "flang/Common/idioms.h"
 #include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Semantics/symbol.h"
@@ -199,7 +200,15 @@ std::optional<Expr<SubscriptInteger>> ProcedureRef::LEN() const {
     // ProcedureDesignator::LEN() because they're independent of the
     // lengths of the actual arguments.
   }
-  return proc_.LEN();
+  if (auto len{proc_.LEN()}) {
+    if (IsActuallyConstant(*len)) {
+      return len;
+    }
+    // TODO: Handle cases where the length of a function result is a
+    // safe expression in terms of actual argument values, after substituting
+    // actual argument expressions for INTENT(IN)/VALUE dummy arguments.
+  }
+  return std::nullopt;
 }
 
 int ProcedureRef::Rank() const {

diff  --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index b19effa980233..2de0de668d856 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -267,7 +267,10 @@ static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) {
   }
   if (auto dyType{DynamicType::From(ultimate)}) {
     if (auto len{dyType->GetCharLength()}) {
-      if (ultimate.owner().IsDerivedType() || IsScopeInvariantExpr(*len)) {
+      if (auto constLen{ToInt64(*len)}) {
+        return Expr<SubscriptInteger>{std::max<std::int64_t>(*constLen, 0)};
+      } else if (ultimate.owner().IsDerivedType() ||
+          IsScopeInvariantExpr(*len)) {
         return AsExpr(Extremum<SubscriptInteger>{
             Ordering::Greater, Expr<SubscriptInteger>{0}, std::move(*len)});
       }

diff  --git a/flang/test/Evaluate/rewrite01.f90 b/flang/test/Evaluate/rewrite01.f90
index 94c43d95ab27a..0d781094b3d56 100644
--- a/flang/test/Evaluate/rewrite01.f90
+++ b/flang/test/Evaluate/rewrite01.f90
@@ -112,9 +112,21 @@ subroutine len_test(a,b, c, d, e, n, m)
   external d
   integer, intent(in) :: n, m
   character(n), intent(in) :: e
+  interface
+     function fun1(L)
+       character(L) :: fun1
+       integer :: L
+     end function fun1
+  end interface
+  interface
+     function mofun(L)
+       character(L) :: mofun
+       integer, intent(in) :: L
+     end function mofun
+  end interface
 
-  !CHECK: PRINT *, int(a%len,kind=8)
-  print *, len(a, kind=8)
+  !CHECK: PRINT *, int(int(a%len,kind=8),kind=4)
+  print *, len(a)
   !CHECK: PRINT *, 5_4
   print *, len(a(1:5))
   !CHECK: PRINT *, len(b(a))
@@ -139,6 +151,10 @@ subroutine len_test(a,b, c, d, e, n, m)
   print *, len(b(a(n:m)))
   !CHECK: PRINT *, int(max(0_8,max(0_8,int(n,kind=8))-4_8+1_8),kind=4)
   print *, len(e(4:))
+  !CHECK: PRINT *, len(fun1(n-m))
+  print *, len(fun1(n-m))
+  !CHECK: PRINT *, len(mofun(m+1_4))
+  print *, len(mofun(m+1))
 end subroutine len_test
 
 end module