diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/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 aType{sameArg->GetType()}) { + resultType = DynamicType{*category, aType->kind()}; + } + break; case KindCode::operand: CHECK(operandArg); resultType = operandArg->GetType(); diff --git a/flang/test/Evaluate/rewrite01.f90 b/flang/test/Evaluate/rewrite01.f90 --- a/flang/test/Evaluate/rewrite01.f90 +++ b/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