diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -898,12 +898,24 @@ context, std::move(result), AsConstantExtents(context, shape)); } +template +ArrayConstructor ArrayConstructorFromMold( + const A &prototype, std::optional> &&length) { + if constexpr (RESULT::category == TypeCategory::Character) { + return ArrayConstructor{ + std::move(length.value()), ArrayConstructorValues{}}; + } else { + return ArrayConstructor{prototype}; + } +} + // array * array case template Expr MapOperation(FoldingContext &context, std::function(Expr &&, Expr &&)> &&f, - const Shape &shape, Expr &&leftValues, Expr &&rightValues) { - ArrayConstructor result{leftValues}; + const Shape &shape, std::optional> &&length, + Expr &&leftValues, Expr &&rightValues) { + auto result{ArrayConstructorFromMold(leftValues, std::move(length))}; auto &leftArrConst{std::get>(leftValues.u)}; if constexpr (common::HasMember) { std::visit( @@ -942,9 +954,9 @@ template Expr MapOperation(FoldingContext &context, std::function(Expr &&, Expr &&)> &&f, - const Shape &shape, Expr &&leftValues, - const Expr &rightScalar) { - ArrayConstructor result{leftValues}; + const Shape &shape, std::optional> &&length, + Expr &&leftValues, const Expr &rightScalar) { + auto result{ArrayConstructorFromMold(leftValues, std::move(length))}; auto &leftArrConst{std::get>(leftValues.u)}; for (auto &leftValue : leftArrConst) { auto &leftScalar{std::get>(leftValue.u)}; @@ -959,9 +971,9 @@ template Expr MapOperation(FoldingContext &context, std::function(Expr &&, Expr &&)> &&f, - const Shape &shape, const Expr &leftScalar, - Expr &&rightValues) { - ArrayConstructor result{leftScalar}; + const Shape &shape, std::optional> &&length, + const Expr &leftScalar, Expr &&rightValues) { + auto result{ArrayConstructorFromMold(leftScalar, std::move(length))}; if constexpr (common::HasMember) { std::visit( [&](auto &&kindExpr) { @@ -987,6 +999,15 @@ context, std::move(result), AsConstantExtents(context, shape)); } +template +std::optional> ComputeResultLength( + Operation &operation) { + if constexpr (RESULT::category == TypeCategory::Character) { + return Expr{operation.derived()}.LEN(); + } + return std::nullopt; +} + // ApplyElementwise() recursively folds the operand expression(s) of an // operation, then attempts to apply the operation to the (corresponding) // scalar element(s) of those operands. Returns std::nullopt for scalars @@ -1024,6 +1045,7 @@ Operation &operation, std::function(Expr &&, Expr &&)> &&f) -> std::optional> { + auto resultLength{ComputeResultLength(operation)}; auto &leftExpr{operation.left()}; leftExpr = Fold(context, std::move(leftExpr)); auto &rightExpr{operation.right()}; @@ -1038,25 +1060,26 @@ CheckConformanceFlags::EitherScalarExpandable) .value_or(false /*fail if not known now to conform*/)) { return MapOperation(context, std::move(f), *leftShape, - std::move(*left), std::move(*right)); + std::move(resultLength), std::move(*left), + std::move(*right)); } else { return std::nullopt; } return MapOperation(context, std::move(f), *leftShape, - std::move(*left), std::move(*right)); + std::move(resultLength), std::move(*left), std::move(*right)); } } } else if (IsExpandableScalar(rightExpr)) { - return MapOperation( - context, std::move(f), *leftShape, std::move(*left), rightExpr); + return MapOperation(context, std::move(f), *leftShape, + std::move(resultLength), std::move(*left), rightExpr); } } } } else if (rightExpr.Rank() > 0 && IsExpandableScalar(leftExpr)) { if (std::optional shape{GetShape(context, rightExpr)}) { if (auto right{AsFlatArrayConstructor(rightExpr)}) { - return MapOperation( - context, std::move(f), *shape, leftExpr, std::move(*right)); + return MapOperation(context, std::move(f), *shape, + std::move(resultLength), leftExpr, std::move(*right)); } } } diff --git a/flang/test/Evaluate/folding22.f90 b/flang/test/Evaluate/folding22.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Evaluate/folding22.f90 @@ -0,0 +1,23 @@ +! RUN: %S/test_folding.sh %s %t %flang_fc1 +! REQUIRES: shell + +! Test character concatenation folding + +logical, parameter :: test_scalar_scalar = ('ab' // 'cde').eq.('abcde') + +character(2), parameter :: scalar_array(2) = ['1','2'] // 'a' +logical, parameter :: test_scalar_array = all(scalar_array.eq.(['1a', '2a'])) + +character(2), parameter :: array_scalar(2) = '1' // ['a', 'b'] +logical, parameter :: test_array_scalar = all(array_scalar.eq.(['1a', '1b'])) + +character(2), parameter :: array_array(2) = ['1','2'] // ['a', 'b'] +logical, parameter :: test_array_array = all(array_array.eq.(['1a', '2b'])) + + +character(1), parameter :: input(2) = ['x', 'y'] +character(*), parameter :: zero_sized(*) = input(2:1:1) // 'abcde' +logical, parameter :: test_zero_sized = len(zero_sized).eq.6 + +end +