[flang-commits] [PATCH] D134970: [flang] Do not resolve TRIM/REPEAT length to its argument length

[Jean Perier via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rGeb1eb7a144ba: [flang] Do not resolve TRIM/REPEAT length to its argument length (authored by jeanPerier).

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D134970/new/

https://reviews.llvm.org/D134970

Files:
  flang/lib/Evaluate/intrinsics.cpp
  flang/test/Evaluate/rewrite01.f90


Index: flang/test/Evaluate/rewrite01.f90
===================================================================
--- flang/test/Evaluate/rewrite01.f90
+++ flang/test/Evaluate/rewrite01.f90
@@ -112,6 +112,7 @@
   external d
   integer, intent(in) :: n, m
   character(n), intent(in) :: e
+  character(5), parameter :: cparam = "abc  "
   interface
      function fun1(L)
        character(L) :: fun1
@@ -155,6 +156,14 @@
   print *, len(fun1(n-m))
   !CHECK: PRINT *, len(mofun(m+1_4))
   print *, len(mofun(m+1))
+  !CHECK: PRINT *, 3_4
+  print *, len(trim(cparam))
+  !CHECK: PRINT *, len(trim(c))
+  print *, len(trim(c))
+  !CHECK: PRINT *, 40_4
+  print *, len(repeat(c, 4))
+  !CHECK: PRINT *, len(repeat(c,int(i,kind=8)))
+  print *, len(repeat(c, i))
 end subroutine len_test
 
 !CHECK-LABEL: associate_tests
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -78,7 +78,11 @@
     defaultRealKind, // is also the default COMPLEX kind
     doublePrecision, defaultCharKind, defaultLogicalKind,
     any, // matches any kind value; each instance is independent
-    same, // match any kind, but all "same" kinds must be equal
+    // match any kind, but all "same" kinds must be equal. For characters, also
+    // implies that lengths must be equal.
+    same,
+    // for character results, take "same" argument kind but not length
+    sameKindButNotLength,
     operand, // match any kind, with promotion (non-standard)
     typeless, // BOZ literals are INTEGER with this kind
     teamType, // TEAM_TYPE from module ISO_FORTRAN_ENV (for coarrays)
@@ -149,6 +153,8 @@
 static constexpr TypePattern SameFloating{FloatingType, KindCode::same};
 static constexpr TypePattern SameNumeric{NumericType, KindCode::same};
 static constexpr TypePattern SameChar{CharType, KindCode::same};
+static constexpr TypePattern SameCharNewLen{
+    CharType, KindCode::sameKindButNotLength};
 static constexpr TypePattern SameLogical{LogicalType, KindCode::same};
 static constexpr TypePattern SameRelatable{RelatableType, KindCode::same};
 static constexpr TypePattern SameIntrinsic{IntrinsicType, KindCode::same};
@@ -702,7 +708,7 @@
             {"ordered", AnyLogical, Rank::scalar, Optionality::optional}},
         SameType, Rank::scalar, IntrinsicClass::transformationalFunction},
     {"repeat", {{"string", SameChar, Rank::scalar}, {"ncopies", AnyInt}},
-        SameChar, Rank::scalar, IntrinsicClass::transformationalFunction},
+        SameCharNewLen, Rank::scalar, IntrinsicClass::transformationalFunction},
     {"reshape",
         {{"source", SameType, Rank::array}, {"shape", AnyInt, Rank::shape},
             {"pad", SameType, Rank::array, Optionality::optional},
@@ -799,7 +805,7 @@
         SameType, Rank::vector, IntrinsicClass::transformationalFunction},
     {"transpose", {{"matrix", SameType, Rank::matrix}}, SameType, Rank::matrix,
         IntrinsicClass::transformationalFunction},
-    {"trim", {{"string", SameChar, Rank::scalar}}, SameChar, Rank::scalar,
+    {"trim", {{"string", SameChar, Rank::scalar}}, SameCharNewLen, Rank::scalar,
         IntrinsicClass::transformationalFunction},
     {"ubound",
         {{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM,
@@ -1784,6 +1790,12 @@
         }
       }
       break;
+    case KindCode::sameKindButNotLength:
+      CHECK(sameArg);
+      if (std::optional<DynamicType> aType{sameArg->GetType()}) {
+        resultType = DynamicType{*category, aType->kind()};
+      }
+      break;
     case KindCode::operand:
       CHECK(operandArg);
       resultType = operandArg->GetType();


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D134970.464639.patch
Type: text/x-patch
Size: 3702 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221003/3ca19fd3/attachment-0001.bin>