[flang] Do not resolve TRIM/REPEAT length to its argument length

[jeanPerier]

Summary

For TRIM and REPEAT calls, semantics was creating ProcedureDesignators
using the length parameter of the arguments. This caused bugs when
folding LEN(TRIM(char_explicit_constant_length)). The same did not
appeared in folding for REPEAT because it is rewritten at a higher
level to LEN(c)*N.

This is not only a folding issue since any place (like lowering) may
try to use the bad length parameter from the created ProcedureDesignator.

Update intrinsic resolution to not copy the length parameter for TRIM
and REPEAT.

[kiranchandramohan]

pop2 in spec2017 stopped building after this change.

I have a small reproducer. I get the following error

error: Semantic errors in my_test.f90
./my_test.f90:5:12: error: Internal error: Expression analysis failed on: Expr -> ArrayConstructor -> AcSpec
| AcValue -> Expr -> FunctionReference -> Call
| | ProcedureDesignator -> Name = 'trim'
| | ActualArgSpec
| | | ActualArg -> Expr -> Designator -> DataRef -> Name = 'n'

    call sb1((/trim(n)/))

in

program mn
  character(len=6) :: n
  n = 'hello '
  call sb1((/trim(n)/))
contains                                 
subroutine sb1(nm)
  character(*) :: nm(:)
  print *, len(nm(1))
end subroutine
end program

It was previously computing an incorrect result. So it is probably not a regression but pop2 test version used to build and run correctly before this change. Please let me know if you want me to create a github issue.

flang/lib/Evaluate/intrinsics.cpp

 static constexpr CategorySet IntrinsicType{
     IntType | RealType | ComplexType | CharType | LogicalType};
 static constexpr CategorySet AnyType{IntrinsicType | DerivedType};
 
 ENUM_CLASS(KindCode, none, defaultIntegerKind,
     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)
     kindArg, // this argument is KIND=
     effectiveKind, // for function results: "kindArg" value, possibly defaulted
     dimArg, // this argument is DIM=
     likeMultiply, // for DOT_PRODUCT and MATMUL
     subscript, // address-sized integer

 // a "Same".
 static constexpr TypePattern SameInt{IntType, KindCode::same};
 static constexpr TypePattern SameReal{RealType, KindCode::same};
 static constexpr TypePattern SameIntOrReal{IntOrRealType, KindCode::same};
 static constexpr TypePattern SameComplex{ComplexType, KindCode::same};
 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};
 static constexpr TypePattern SameDerivedType{
     CategorySet{TypeCategory::Derived}, KindCode::same};
 static constexpr TypePattern SameType{AnyType, KindCode::same};
 
 // Match some kind of some INTEGER or REAL type(s); when argument types
static const IntrinsicInterface genericIntrinsicFunction[]{
     {"reduce",
         {{"array", SameType, Rank::array},
             {"operation", SameType, Rank::reduceOperation}, MissingDIM,
             OptionalMASK,
             {"identity", SameType, Rank::scalar, Optionality::optional},
             {"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},
             {"order", AnyInt, Rank::vector, Optionality::optional}},
         SameType, Rank::shaped, IntrinsicClass::transformationalFunction},
     {"rrspacing", {{"x", SameReal}}, SameReal},
     {"same_type_as",
         {{"a", ExtensibleDerived, Rank::anyOrAssumedRank},
// NULL() is a special case handled in Probe() below
         SameType, Rank::vector, IntrinsicClass::transformationalFunction},
     {"transfer",
         {{"source", AnyData, Rank::anyOrAssumedRank},
             {"mold", SameType, Rank::anyOrAssumedRank},
             {"size", AnyInt, Rank::scalar}},
         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,
             SizeDefaultKIND},
         KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
     {"ubound", {{"array", AnyData, Rank::anyOrAssumedRank}, SizeDefaultKIND},
         KINDInt, Rank::vector, IntrinsicClass::inquiryFunction},
     {"ucobound",
case KindCode::same:
       if (std::optional<DynamicType> aType{sameArg->GetType()}) {
         if (result.categorySet.test(aType->category())) {
           resultType = *aType;
         } else {
           resultType = DynamicType{*category, aType->kind()};
         }
       }
       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();
       CHECK(!resultType || result.categorySet.test(resultType->category()));
       break;
     case KindCode::effectiveKind:
       CHECK(kindDummyArg);
       CHECK(result.categorySet == CategorySet{*category});

flang/test/Evaluate/rewrite01.f90

subroutine len_test(a,b, c, d, e, n, m)
   character(*), intent(in) :: a
   character(*) :: b
   external b
   character(10), intent(in) :: c
   character(10) :: d
   external d
   integer, intent(in) :: n, m
   character(n), intent(in) :: e
+  character(5), parameter :: cparam = "abc  "
   interface
      function fun1(L)
        character(L) :: fun1
        integer :: L
      end function fun1
   end interface
   interface
      function mofun(L)
subroutine len_test(a,b, c, d, e, n, m)
   !CHECK: PRINT *, len(b(a(int(n,kind=8):int(m,kind=8))))
   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))
+  !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
 subroutine associate_tests(p)
   real, pointer :: p(:)
   real :: a(10:20)
   interface
     subroutine may_change_p_bounds(p)