diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h index d5b30f53a766..7cf01a85ba4b 100644 --- a/flang/include/flang/Evaluate/initial-image.h +++ b/flang/include/flang/Evaluate/initial-image.h @@ -107,7 +107,8 @@ public: // Conversions to constant initializers std::optional> AsConstant(FoldingContext &, - const DynamicType &, const ConstantSubscripts &, bool padWithZero = false, + const DynamicType &, std::optional charLength, + const ConstantSubscripts &, bool padWithZero = false, ConstantSubscript offset = 0) const; std::optional> AsConstantPointer( ConstantSubscript offset = 0) const; diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h index 0338dcb1f145..c8baa635ea6e 100644 --- a/flang/include/flang/Evaluate/type.h +++ b/flang/include/flang/Evaluate/type.h @@ -157,8 +157,9 @@ public: std::optional> GetCharLength() const; std::size_t GetAlignment(const TargetCharacteristics &) const; - std::optional> MeasureSizeInBytes( - FoldingContext &, bool aligned) const; + std::optional> MeasureSizeInBytes(FoldingContext &, + bool aligned, + std::optional charLength = std::nullopt) const; std::string AsFortran() const; std::string AsFortran(std::string &&charLenExpr) const; diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp index 6f61a6829484..0c5d2c24079c 100644 --- a/flang/lib/Evaluate/fold.cpp +++ b/flang/lib/Evaluate/fold.cpp @@ -235,8 +235,14 @@ std::optional> FoldTransfer( } } std::optional moldType; - if (arguments[1]) { + std::optional moldLength; + if (arguments[1]) { // MOLD= moldType = arguments[1]->GetType(); + if (moldType && moldType->category() == TypeCategory::Character) { + if (const auto *chExpr{UnwrapExpr>(arguments[1])}) { + moldLength = ToInt64(Fold(context, chExpr->LEN())); + } + } } std::optional extents; if (arguments.size() == 2) { // no SIZE= @@ -260,7 +266,8 @@ std::optional> FoldTransfer( } } } - if (sourceBytes && IsActuallyConstant(*source) && moldType && extents) { + if (sourceBytes && IsActuallyConstant(*source) && moldType && extents && + (moldLength || moldType->category() != TypeCategory::Character)) { std::size_t elements{ extents->empty() ? 1 : static_cast((*extents)[0])}; std::size_t totalBytes{*sourceBytes * elements}; @@ -272,7 +279,7 @@ std::optional> FoldTransfer( image.Add(0, *sourceBytes, *source, context)}; CHECK(imageResult == InitialImage::Ok); return image.AsConstant( - context, *moldType, *extents, true /*pad with 0*/); + context, *moldType, moldLength, *extents, true /*pad with 0*/); } } return std::nullopt; diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp index 0dee0eae059b..a5f77a603ddb 100644 --- a/flang/lib/Evaluate/initial-image.cpp +++ b/flang/lib/Evaluate/initial-image.cpp @@ -73,10 +73,11 @@ public: using Result = std::optional>; using Types = AllTypes; AsConstantHelper(FoldingContext &context, const DynamicType &type, - const ConstantSubscripts &extents, const InitialImage &image, - bool padWithZero = false, ConstantSubscript offset = 0) - : context_{context}, type_{type}, image_{image}, extents_{extents}, - padWithZero_{padWithZero}, offset_{offset} { + std::optional charLength, const ConstantSubscripts &extents, + const InitialImage &image, bool padWithZero = false, + ConstantSubscript offset = 0) + : context_{context}, type_{type}, charLength_{charLength}, image_{image}, + extents_{extents}, padWithZero_{padWithZero}, offset_{offset} { CHECK(!type.IsPolymorphic()); } template Result Test() { @@ -92,8 +93,8 @@ public: using Scalar = typename Const::Element; std::size_t elements{TotalElementCount(extents_)}; std::vector typedValue(elements); - auto elemBytes{ - ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))}; + auto elemBytes{ToInt64(type_.MeasureSizeInBytes( + context_, GetRank(extents_) > 0, charLength_))}; CHECK(elemBytes && *elemBytes >= 0); std::size_t stride{static_cast(*elemBytes)}; CHECK(offset_ + elements * stride <= image_.data_.size() || padWithZero_); @@ -123,7 +124,7 @@ public: CHECK(componentExtents.has_value()); for (std::size_t j{0}; j < elements; ++j, at += stride) { if (Result value{image_.AsConstant(context_, *componentType, - *componentExtents, padWithZero_, at)}) { + std::nullopt, *componentExtents, padWithZero_, at)}) { typedValue[j].emplace(component, std::move(*value)); } } @@ -182,6 +183,7 @@ public: private: FoldingContext &context_; const DynamicType &type_; + std::optional charLength_; const InitialImage &image_; ConstantSubscripts extents_; // a copy bool padWithZero_; @@ -189,10 +191,11 @@ private: }; std::optional> InitialImage::AsConstant(FoldingContext &context, - const DynamicType &type, const ConstantSubscripts &extents, - bool padWithZero, ConstantSubscript offset) const { - return common::SearchTypes( - AsConstantHelper{context, type, extents, *this, padWithZero, offset}); + const DynamicType &type, std::optional charLength, + const ConstantSubscripts &extents, bool padWithZero, + ConstantSubscript offset) const { + return common::SearchTypes(AsConstantHelper{ + context, type, charLength, extents, *this, padWithZero, offset}); } std::optional> InitialImage::AsConstantPointer( diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index f5d5d5b0efc3..6c9431b50022 100644 --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -140,7 +140,8 @@ std::size_t DynamicType::GetAlignment( } std::optional> DynamicType::MeasureSizeInBytes( - FoldingContext &context, bool aligned) const { + FoldingContext &context, bool aligned, + std::optional charLength) const { switch (category_) { case TypeCategory::Integer: case TypeCategory::Real: @@ -149,7 +150,9 @@ std::optional> DynamicType::MeasureSizeInBytes( return Expr{ context.targetCharacteristics().GetByteSize(category_, kind_)}; case TypeCategory::Character: - if (auto len{GetCharLength()}) { + if (auto len{charLength ? Expr{Constant{ + *charLength}} + : GetCharLength()}) { return Fold(context, Expr{ context.targetCharacteristics().GetByteSize(category_, kind_)} * diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp index 52191edbab6e..959c74b62d7c 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -569,7 +569,8 @@ static void PopulateWithComponentDefaults(SymbolDataInitialization &init, if (auto extents{evaluate::GetConstantExtents( foldingContext, component)}) { if (auto extant{init.image.AsConstant(foldingContext, *dyType, - *extents, false /*don't pad*/, componentOffset)}) { + std::nullopt, *extents, false /*don't pad*/, + componentOffset)}) { initialized = !(*extant == *object->init()); } } @@ -905,8 +906,8 @@ void ConstructInitializer(const Symbol &symbol, } } else if (auto symbolType{evaluate::DynamicType::From(symbol)}) { if (auto extents{evaluate::GetConstantExtents(context, symbol)}) { - mutableObject.set_init( - initialization.image.AsConstant(context, *symbolType, *extents)); + mutableObject.set_init(initialization.image.AsConstant( + context, *symbolType, std::nullopt, *extents)); } else { exprAnalyzer.Say(symbol.name(), "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US, diff --git a/flang/test/Evaluate/fold-transfer.f90 b/flang/test/Evaluate/fold-transfer.f90 index 833c828a6296..4210fd6fe295 100644 --- a/flang/test/Evaluate/fold-transfer.f90 +++ b/flang/test/Evaluate/fold-transfer.f90 @@ -39,4 +39,7 @@ module m character*5, parameter :: le1c(*) = transfer(le1, [character(5)::]) character*5, parameter :: be1c(*) = transfer(be1, [character(5)::]) logical, parameter :: test_i2c_s = all(le1c == ["abcd"//char(0)]) .or. all(be1c == ["efgh"//char(0)]) + + character*4, parameter :: i2ss1 = transfer(int(z'61626364', 4), "12345678"(2:5)) + logical, parameter :: test_i2ss1 = any(i2ss1 == ["abcd", "dcba"]) end module