[flang-commits] [flang] [flang] Move whole allocatable assignment implicit conversion to lowering (PR #70317)
via flang-commits
flang-commits at lists.llvm.org
Thu Oct 26 04:11:17 PDT 2023
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/70317
The front-end is making implicit conversions explicit in assignment and structure constructors.
While this generally helps and is needed by semantics to fold structure constructors correctly, this is incorrect when the LHS or component is an allocatable. The RHS may have non default lower bounds that should be propagated to the LHS, and making the conversion explicit changes the semantics. In the structure constructor, the situation is even worse since Fortran 2018 7.5.10 point 7 allows the value to be a reference to an unallocated allocatable, and adding an explicit conversion in semantics will cause a segfault.
This patch removes the explicit convert in semantics when the LHS/component is a whole allocatable, and update lowering to deal with the conversion insertion, dealing with preserving the lower bounds and the tricky structure constructor case.
>From a4e180d8292ece43148484cd24707c8e9b52051b Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 26 Oct 2023 02:52:26 -0700
Subject: [PATCH] [flang] Move whole allocatable assignment implicit conversion
to lowering
The front-end is making implicit conversions explicit in assignment and
structure constructors.
While this generally helps and is needed by semantics to fold structure
constructors correctly, this is incorrect when the LHS or component is
an allocatable. The RHS may have non default lower bounds that should
be propagated to the LHS, and making the conversion explicit changes
the semantics. In the structure constructor, the situation is even worse
since 7.5.10 point 7 allows the value to be a reference to an
unallocated allocatable, and adding an explicit conversion will cause
a segfault.
This patch removes the explicit convert in semantics when the
LHS/component is a whole allocatable, and update lowering to deal
with the conversion insertion, dealing with preserving the lower
bounds and the tricky structure constructor case.
---
.../flang/Optimizer/Builder/Character.h | 5 +
.../flang/Optimizer/Builder/HLFIRTools.h | 23 ++++
flang/lib/Lower/Bridge.cpp | 73 ++++-------
flang/lib/Lower/ConvertExpr.cpp | 39 +-----
flang/lib/Lower/ConvertExprToHLFIR.cpp | 121 ++++++------------
flang/lib/Optimizer/Builder/Character.cpp | 39 ++++++
flang/lib/Optimizer/Builder/HLFIRTools.cpp | 99 ++++++++++++++
flang/lib/Semantics/expression.cpp | 34 ++++-
flang/test/Lower/HLFIR/charconvert.f90 | 8 +-
.../implicit-type-conversion-allocatable.f90 | 40 ++++++
flang/test/Lower/charconvert.f90 | 2 +-
11 files changed, 309 insertions(+), 174 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/implicit-type-conversion-allocatable.f90
diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h
index c83076ee81987d9..658118eddcc9099 100644
--- a/flang/include/flang/Optimizer/Builder/Character.h
+++ b/flang/include/flang/Optimizer/Builder/Character.h
@@ -235,6 +235,11 @@ std::pair<mlir::Value, mlir::Value>
extractCharacterProcedureTuple(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value tuple, bool openBoxProc = true);
+fir::CharBoxValue convertCharacterKind(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ fir::CharBoxValue srcBoxChar,
+ int toKind);
+
} // namespace fir::factory
#endif // FORTRAN_OPTIMIZER_BUILDER_CHARACTER_H
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index f0b66baddd9603d..124c0fdc193dc53 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -427,6 +427,29 @@ std::pair<hlfir::Entity, mlir::Value>
createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
hlfir::Entity mold);
+hlfir::EntityWithAttributes convertCharacterKind(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity scalarChar,
+ int toKind);
+
+/// Materialize an implicit Fortran type conversion from \p source to \p toType.
+/// This is a no-op if the Fortran category and KIND of \p source are
+/// the same as the one in \p toType. This is also a no-op if \p toType is an
+/// unlimited polymorphic. For characters, this implies that a conversion is
+/// only inserted in case of KIND mismatch (and not in case of length mismatch),
+/// and that the resulting entity length is the same as the one from \p source.
+/// It is valid to call this helper if \p source is an array. If a conversion is
+/// inserted for arrays, a clean-up will be returned. If not conversion is
+/// needed, the source is returned.
+/// Beware that the resulting entity mlir type may not be toType: it will be a
+/// Fortran entity with the same Fortran category and KIND.
+/// If preserveLowerBounds is set, the returned entity will have the same lower
+/// bounds as \p source.
+std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>
+genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity source, mlir::Type toType,
+ bool preserveLowerBounds);
+
} // namespace hlfir
#endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 761cedb97fb959e..3adc9c5d1105da7 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3372,47 +3372,25 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
}
- /// Given converted LHS and RHS of the assignment, generate
- /// explicit type conversion for implicit Logical<->Integer
- /// conversion. Return Value representing the converted RHS,
- /// if the implicit Logical<->Integer is detected, otherwise,
- /// return nullptr. The caller is responsible for inserting
- /// DestroyOp in case the returned value has hlfir::ExprType.
- mlir::Value
- genImplicitLogicalConvert(const Fortran::evaluate::Assignment &assign,
- hlfir::Entity rhs,
- Fortran::lower::StatementContext &stmtCtx) {
- mlir::Type fromTy = rhs.getFortranElementType();
- if (!fromTy.isa<mlir::IntegerType, fir::LogicalType>())
- return nullptr;
-
- mlir::Type toTy = hlfir::getFortranElementType(genType(assign.lhs));
- if (fromTy == toTy)
- return nullptr;
- if (!toTy.isa<mlir::IntegerType, fir::LogicalType>())
- return nullptr;
-
+ /// Given converted LHS and RHS of the assignment, materialize any
+ /// implicit conversion of the RHS to the LHS type. The front-end
+ /// usually already makes those explicit, except for none-standard
+ /// LOGICAL <-> INTEGER, or if the LHS is a whole allocatable
+ /// (making the conversion explicit in the front-end would prevent
+ /// propagation of the LHS lower bound in the reallocation).
+ /// If array temporaries or values are created, the cleanups are
+ /// added in the statement context.
+ hlfir::Entity genImplicitConvert(const Fortran::evaluate::Assignment &assign,
+ hlfir::Entity rhs, bool preserveLowerBounds,
+ Fortran::lower::StatementContext &stmtCtx) {
mlir::Location loc = toLocation();
auto &builder = getFirOpBuilder();
- if (assign.rhs.Rank() == 0)
- return builder.createConvert(loc, toTy, rhs);
-
- mlir::Value shape = hlfir::genShape(loc, builder, rhs);
- auto genKernel =
- [&rhs, &toTy](mlir::Location loc, fir::FirOpBuilder &builder,
- mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
- auto elementPtr = hlfir::getElementAt(loc, builder, rhs, oneBasedIndices);
- auto val = hlfir::loadTrivialScalar(loc, builder, elementPtr);
- return hlfir::EntityWithAttributes{builder.createConvert(loc, toTy, val)};
- };
- mlir::Value convertedRhs = hlfir::genElementalOp(
- loc, builder, toTy, shape, /*typeParams=*/{}, genKernel,
- /*isUnordered=*/true);
- fir::FirOpBuilder *bldr = &builder;
- stmtCtx.attachCleanup([loc, bldr, convertedRhs]() {
- bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
- });
- return convertedRhs;
+ mlir::Type toType = genType(assign.lhs);
+ auto valueAndPair = hlfir::genTypeAndKindConvert(loc, builder, rhs, toType,
+ preserveLowerBounds);
+ if (valueAndPair.second)
+ stmtCtx.attachCleanup(*valueAndPair.second);
+ return hlfir::Entity{valueAndPair.first};
}
static void
@@ -3476,14 +3454,17 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// loops early if possible. This also dereferences pointer and
// allocatable RHS: the target is being assigned from.
rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
- // In intrinsic assignments, Logical<->Integer assignments are allowed as
- // an extension, but there is no explicit Convert expression for the RHS.
- // Recognize the type mismatch here and insert explicit scalar convert or
- // ElementalOp for array assignment.
+ // In intrinsic assignments, the LHS type may not match the RHS type, in
+ // which case an implicit conversion of the LHS must be done. The
+ // front-end usually makes it explicit, unless it cannot (whole
+ // allocatable LHS or Logical<->Integer assignment extension). Recognize
+ // any type mismatches here and insert explicit scalar convert or
+ // ElementalOp for array assignment. Preserve the RHS lower bounds on the
+ // converted entity in case of assignment to whole allocatables so to
+ // propagate the lower bounds to the LHS in case of reallocation.
if (!userDefinedAssignment)
- if (mlir::Value conversion =
- genImplicitLogicalConvert(assign, rhs, stmtCtx))
- rhs = hlfir::Entity{conversion};
+ rhs = genImplicitConvert(assign, rhs, isWholeAllocatableAssignment,
+ stmtCtx);
return rhs;
};
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 1a2b3856c526716..76d810e9df6dc2d 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1237,41 +1237,8 @@ class ScalarExprLowering {
[&](const fir::CharBoxValue &boxchar) -> ExtValue {
if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
TC2 == TC1) {
- // Use char_convert. Each code point is translated from a
- // narrower/wider encoding to the target encoding. For example, 'A'
- // may be translated from 0x41 : i8 to 0x0041 : i16. The symbol
- // for euro (0x20AC : i16) may be translated from a wide character
- // to "0xE2 0x82 0xAC" : UTF-8.
- mlir::Value bufferSize = boxchar.getLen();
- auto kindMap = builder.getKindMap();
- mlir::Value boxCharAddr = boxchar.getAddr();
- auto fromTy = boxCharAddr.getType();
- if (auto charTy = fromTy.dyn_cast<fir::CharacterType>()) {
- // boxchar is a value, not a variable. Turn it into a temporary.
- // As a value, it ought to have a constant LEN value.
- assert(charTy.hasConstantLen() && "must have constant length");
- mlir::Value tmp = builder.createTemporary(loc, charTy);
- builder.create<fir::StoreOp>(loc, boxCharAddr, tmp);
- boxCharAddr = tmp;
- }
- auto fromBits =
- kindMap.getCharacterBitsize(fir::unwrapRefType(fromTy)
- .cast<fir::CharacterType>()
- .getFKind());
- auto toBits = kindMap.getCharacterBitsize(
- ty.cast<fir::CharacterType>().getFKind());
- if (toBits < fromBits) {
- // Scale by relative ratio to give a buffer of the same length.
- auto ratio = builder.createIntegerConstant(
- loc, bufferSize.getType(), fromBits / toBits);
- bufferSize =
- builder.create<mlir::arith::MulIOp>(loc, bufferSize, ratio);
- }
- auto dest = builder.create<fir::AllocaOp>(
- loc, ty, mlir::ValueRange{bufferSize});
- builder.create<fir::CharConvertOp>(loc, boxCharAddr,
- boxchar.getLen(), dest);
- return fir::CharBoxValue{dest, boxchar.getLen()};
+ return fir::factory::convertCharacterKind(builder, loc, boxchar,
+ KIND);
} else {
fir::emitFatalError(
loc, "unsupported evaluate::Convert between CHARACTER type "
@@ -3965,7 +3932,7 @@ class ArrayExprLowering {
auto castTo = builder.createConvert(loc, memrefTy, origVal);
origVal = builder.create<fir::EmboxOp>(loc, eleTy, castTo);
}
- mlir::Value val = builder.createConvert(loc, eleTy, origVal);
+ mlir::Value val = builder.convertWithSemantics(loc, eleTy, origVal);
if (isBoundsSpec()) {
assert(lbounds.has_value());
auto lbs = *lbounds;
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 1da6a5bdd54784e..5a51493c9aaa5d4 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1367,37 +1367,7 @@ struct UnaryOp<
hlfir::Entity lhs) {
if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
TC2 == TC1) {
- auto kindMap = builder.getKindMap();
- mlir::Type fromTy = lhs.getFortranElementType();
- mlir::Value origBufferSize = genCharLength(loc, builder, lhs);
- mlir::Value bufferSize{origBufferSize};
- auto fromBits = kindMap.getCharacterBitsize(
- fir::unwrapRefType(fromTy).cast<fir::CharacterType>().getFKind());
- mlir::Type toTy = Fortran::lower::getFIRType(
- builder.getContext(), TC1, KIND, /*params=*/std::nullopt);
- auto toBits = kindMap.getCharacterBitsize(
- toTy.cast<fir::CharacterType>().getFKind());
- if (toBits < fromBits) {
- // Scale by relative ratio to give a buffer of the same length.
- auto ratio = builder.createIntegerConstant(loc, bufferSize.getType(),
- fromBits / toBits);
- bufferSize =
- builder.create<mlir::arith::MulIOp>(loc, bufferSize, ratio);
- }
- // allocate space on the stack for toBuffer
- auto dest = builder.create<fir::AllocaOp>(loc, toTy,
- mlir::ValueRange{bufferSize});
- auto src = hlfir::convertToAddress(loc, builder, lhs,
- lhs.getFortranElementType());
- builder.create<fir::CharConvertOp>(loc, src.first.getCharBox()->getAddr(),
- origBufferSize, dest);
- if (src.second.has_value())
- src.second.value()();
-
- return hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
- loc, dest, "ctor.temp", /*shape=*/nullptr,
- /*typeparams=*/mlir::ValueRange{origBufferSize},
- fir::FortranVariableFlagsAttr{})};
+ return hlfir::convertCharacterKind(loc, builder, lhs, KIND);
}
mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1,
KIND, /*params=*/std::nullopt);
@@ -1789,7 +1759,7 @@ class HlfirBuilder {
// If it is allocatable, then using AssignOp for unallocated RHS
// will cause illegal dereference. When an unallocated allocatable
// value is used to construct an allocatable component, the component
- // must just stay unallocated.
+ // must just stay unallocated (see Fortran 2018 7.5.10 point 7).
// If the component is allocatable and RHS is NULL() expression, then
// we can just skip it: the LHS must remain unallocated with its
@@ -1798,56 +1768,44 @@ class HlfirBuilder {
Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
continue;
+ bool keepLhsLength = false;
+ if (allowRealloc)
+ if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
+ keepLhsLength =
+ declType->category() ==
+ Fortran::semantics::DeclTypeSpec::Category::Character &&
+ !declType->characterTypeSpec().length().isDeferred();
// Handle special case when the initializer expression is
// '{%SET_LENGTH(x,const_kind)}'. In structure constructor,
- // SET_LENGTH is used for initializers of character allocatable
- // components with *explicit* length, because they have to keep
- // their length regardless of the initializer expression's length.
- // We cannot just lower SET_LENGTH into hlfir.set_length in case
- // when 'x' is allocatable: if 'x' is unallocated, it is not clear
- // what hlfir.expr should be produced by hlfir.set_length.
- // So whenever the initializer expression is SET_LENGTH we
- // recognize it as the directive to keep the explicit length
- // of the LHS component, and we completely ignore 'const_kind'
- // operand assuming that it matches the LHS component's explicit
- // length. Note that in case when LHS component has deferred length,
- // the FE does not produce SET_LENGTH expression.
- //
- // When SET_LENGTH is recognized, we use 'x' as the initializer
- // for the LHS component. If 'x' is allocatable, the dynamic
- // isAllocated check will guard the assign operation as usual.
- bool keepLhsLength = false;
- hlfir::Entity rhs = std::visit(
- [&](const auto &x) -> hlfir::Entity {
- using T = std::decay_t<decltype(x)>;
- if constexpr (Fortran::common::HasMember<
- T, Fortran::lower::CategoryExpression>) {
- if constexpr (T::Result::category ==
- Fortran::common::TypeCategory::Character) {
- return std::visit(
- [&](const auto &someKind) -> hlfir::Entity {
- using T = std::decay_t<decltype(someKind)>;
- if (const auto *setLength = std::get_if<
- Fortran::evaluate::SetLength<T::Result::kind>>(
- &someKind.u)) {
- keepLhsLength = true;
- return gen(setLength->left());
- }
-
- return gen(someKind);
- },
- x.u);
- }
- }
- return gen(x);
- },
- expr.u);
-
- if (!allowRealloc || !rhs.isMutableBox()) {
+ // SET_LENGTH is used for initializers of non-allocatable character
+ // components so that the front-end can better
+ // fold and work with these structure constructors.
+ // Here, they are just noise since the assignment semantics will deal
+ // with any length mismatch, and creating an extra temp with the lhs
+ // length is useless.
+ // TODO: should this be moved into an hlfir.assign + hlfir.set_length
+ // pattern rewrite?
+ hlfir::Entity rhs = gen(expr);
+ if (auto set_length = rhs.getDefiningOp<hlfir::SetLengthOp>())
+ rhs = hlfir::Entity{set_length.getString()};
+
+ // lambda to generate `lhs = rhs` and deal with potential rhs implicit
+ // cast
+ auto genAssign = [&] {
rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
- builder.create<hlfir::AssignOp>(loc, rhs, lhs, allowRealloc,
+ auto rhsCastAndCleanup =
+ hlfir::genTypeAndKindConvert(loc, builder, rhs, lhs.getType(),
+ /*preserveLowerBounds=*/allowRealloc);
+ builder.create<hlfir::AssignOp>(loc, rhsCastAndCleanup.first, lhs,
+ allowRealloc,
allowRealloc ? keepLhsLength : false,
/*temporary_lhs=*/true);
+ if (rhsCastAndCleanup.second)
+ (*rhsCastAndCleanup.second)();
+ };
+
+ if (!allowRealloc || !rhs.isMutableBox()) {
+ genAssign();
continue;
}
@@ -1860,14 +1818,7 @@ class HlfirBuilder {
"to mutable box");
mlir::Value isAlloc =
fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *fromBox);
- builder.genIfThen(loc, isAlloc)
- .genThen([&]() {
- rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
- builder.create<hlfir::AssignOp>(loc, rhs, lhs, allowRealloc,
- keepLhsLength,
- /*temporary_lhs=*/true);
- })
- .end();
+ builder.genIfThen(loc, isAlloc).genThen(genAssign).end();
}
return varOp;
diff --git a/flang/lib/Optimizer/Builder/Character.cpp b/flang/lib/Optimizer/Builder/Character.cpp
index 41cdd9a71c735d5..1a068b1313a6cbc 100644
--- a/flang/lib/Optimizer/Builder/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Character.cpp
@@ -851,3 +851,42 @@ fir::CharBoxValue fir::factory::CharacterExprHelper::createCharExtremum(
createAssign(toBuf, fromBuf);
return temp;
}
+
+fir::CharBoxValue
+fir::factory::convertCharacterKind(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ fir::CharBoxValue srcBoxChar, int toKind) {
+ // Use char_convert. Each code point is translated from a
+ // narrower/wider encoding to the target encoding. For example, 'A'
+ // may be translated from 0x41 : i8 to 0x0041 : i16. The symbol
+ // for euro (0x20AC : i16) may be translated from a wide character
+ // to "0xE2 0x82 0xAC" : UTF-8.
+ mlir::Value bufferSize = srcBoxChar.getLen();
+ auto kindMap = builder.getKindMap();
+ mlir::Value boxCharAddr = srcBoxChar.getAddr();
+ auto fromTy = boxCharAddr.getType();
+ if (auto charTy = fromTy.dyn_cast<fir::CharacterType>()) {
+ // boxchar is a value, not a variable. Turn it into a temporary.
+ // As a value, it ought to have a constant LEN value.
+ assert(charTy.hasConstantLen() && "must have constant length");
+ mlir::Value tmp = builder.createTemporary(loc, charTy);
+ builder.create<fir::StoreOp>(loc, boxCharAddr, tmp);
+ boxCharAddr = tmp;
+ }
+ auto fromBits = kindMap.getCharacterBitsize(
+ fir::unwrapRefType(fromTy).cast<fir::CharacterType>().getFKind());
+ auto toBits = kindMap.getCharacterBitsize(toKind);
+ if (toBits < fromBits) {
+ // Scale by relative ratio to give a buffer of the same length.
+ auto ratio = builder.createIntegerConstant(loc, bufferSize.getType(),
+ fromBits / toBits);
+ bufferSize = builder.create<mlir::arith::MulIOp>(loc, bufferSize, ratio);
+ }
+ mlir::Type toType =
+ fir::CharacterType::getUnknownLen(builder.getContext(), toKind);
+ auto dest = builder.createTemporary(loc, toType, /*name=*/{}, /*shape=*/{},
+ mlir::ValueRange{bufferSize});
+ builder.create<fir::CharConvertOp>(loc, boxCharAddr, srcBoxChar.getLen(),
+ dest);
+ return fir::CharBoxValue{dest, srcBoxChar.getLen()};
+}
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index cc4bdf356ae9bf9..3d0a59b468ba791 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -1092,3 +1092,102 @@ hlfir::createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
return {hlfir::Entity{declareOp.getBase()}, isHeapAlloc};
}
+
+hlfir::EntityWithAttributes
+hlfir::convertCharacterKind(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity scalarChar, int toKind) {
+ auto src = hlfir::convertToAddress(loc, builder, scalarChar,
+ scalarChar.getFortranElementType());
+ assert(src.first.getCharBox() && "must be scalar character");
+ fir::CharBoxValue res = fir::factory::convertCharacterKind(
+ builder, loc, *src.first.getCharBox(), toKind);
+ if (src.second.has_value())
+ src.second.value()();
+
+ return hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
+ loc, res.getAddr(), ".temp.kindconvert", /*shape=*/nullptr,
+ /*typeparams=*/mlir::ValueRange{res.getLen()},
+ fir::FortranVariableFlagsAttr{})};
+}
+
+std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>
+hlfir::genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity source, mlir::Type toType,
+ bool preserveLowerBounds) {
+ mlir::Type fromType = source.getFortranElementType();
+ toType = hlfir::getFortranElementType(toType);
+ if (!toType || fromType == toType ||
+ !(fir::isa_trivial(toType) || mlir::isa<fir::CharacterType>(toType)))
+ return {source, std::nullopt};
+
+ std::optional<int> toKindCharConvert;
+ if (auto toCharTy = mlir::dyn_cast<fir::CharacterType>(toType)) {
+ if (auto fromCharTy = mlir::dyn_cast<fir::CharacterType>(fromType))
+ if (toCharTy.getFKind() != fromCharTy.getFKind())
+ toKindCharConvert = toCharTy.getFKind();
+ // Do not convert in case of character length mismatch only, hlfir.assign
+ // deals with it.
+ if (!toKindCharConvert)
+ return {source, std::nullopt};
+ }
+
+ if (source.getRank() == 0) {
+ mlir::Value cast = toKindCharConvert
+ ? mlir::Value{hlfir::convertCharacterKind(
+ loc, builder, source, *toKindCharConvert)}
+ : builder.convertWithSemantics(loc, toType, source);
+ return {hlfir::Entity{cast}, std::nullopt};
+ }
+
+ mlir::Value shape = hlfir::genShape(loc, builder, source);
+ auto genKernel = [source, toType, toKindCharConvert](
+ mlir::Location loc, fir::FirOpBuilder &builder,
+ mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
+ auto elementPtr =
+ hlfir::getElementAt(loc, builder, source, oneBasedIndices);
+ auto val = hlfir::loadTrivialScalar(loc, builder, elementPtr);
+ if (toKindCharConvert)
+ return hlfir::convertCharacterKind(loc, builder, val, *toKindCharConvert);
+ return hlfir::EntityWithAttributes{
+ builder.convertWithSemantics(loc, toType, val)};
+ };
+ llvm::SmallVector<mlir::Value, 1> lenParams;
+ hlfir::genLengthParameters(loc, builder, source, lenParams);
+ mlir::Value convertedRhs =
+ hlfir::genElementalOp(loc, builder, toType, shape, lenParams, genKernel,
+ /*isUnordered=*/true);
+
+ if (preserveLowerBounds && source.hasNonDefaultLowerBounds()) {
+ hlfir::AssociateOp associate =
+ genAssociateExpr(loc, builder, hlfir::Entity{convertedRhs},
+ convertedRhs.getType(), ".tmp.keeplbounds");
+ fir::ShapeOp shapeOp = associate.getShape().getDefiningOp<fir::ShapeOp>();
+ assert(shapeOp && "associate shape must be a fir.shape");
+ const unsigned rank = shapeOp.getExtents().size();
+ llvm::SmallVector<mlir::Value> lbAndExtents;
+ for (unsigned dim = 0; dim < rank; ++dim) {
+ lbAndExtents.push_back(hlfir::genLBound(loc, builder, source, dim));
+ lbAndExtents.push_back(shapeOp.getExtents()[dim]);
+ }
+ auto shapeShiftType = fir::ShapeShiftType::get(builder.getContext(), rank);
+ mlir::Value shapeShift =
+ builder.create<fir::ShapeShiftOp>(loc, shapeShiftType, lbAndExtents);
+ auto declareOp = builder.create<hlfir::DeclareOp>(
+ loc, associate.getFirBase(), associate.getUniqName(), shapeShift,
+ associate.getTypeparams(), /*flags=*/fir::FortranVariableFlagsAttr{});
+ hlfir::Entity castWithLbounds =
+ mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
+ fir::FirOpBuilder *bldr = &builder;
+ auto cleanup = [loc, bldr, convertedRhs, associate]() {
+ bldr->create<hlfir::EndAssociateOp>(loc, associate);
+ bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
+ };
+ return {castWithLbounds, cleanup};
+ }
+
+ fir::FirOpBuilder *bldr = &builder;
+ auto cleanup = [loc, bldr, convertedRhs]() {
+ bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
+ };
+ return {hlfir::Entity{convertedRhs}, cleanup};
+}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 4ccb2c3ef5d0121..1206c82af977b7b 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1857,6 +1857,23 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
return acContext.ToExpr();
}
+// Check if implicit conversion of expr to the symbol type is legal (if needed),
+// and make it explicit if requested.
+MaybeExpr implicitConvertTo(const semantics::Symbol &sym, Expr<SomeType> &&expr,
+ bool keepConvertImplicit) {
+ if (!keepConvertImplicit) {
+ return ConvertToType(sym, std::move(expr));
+ } else {
+ // Test if a convert could be inserted, but do not make it explicit to
+ // preserve the information that expr is a variable.
+ if (ConvertToType(sym, common::Clone(expr))) {
+ return MaybeExpr{std::move(expr)};
+ }
+ }
+ // Illegal implicit convert.
+ return std::nullopt;
+}
+
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::StructureConstructor &structure) {
auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
@@ -2061,7 +2078,15 @@ MaybeExpr ExpressionAnalyzer::Analyze(
visible->name(), symbol->name(), pointer->name());
}
}
- if (MaybeExpr converted{ConvertToType(*symbol, std::move(*value))}) {
+ // Make implicit conversion explicit to allow folding of the structure
+ // constructors and help semantic checking, unless the component is
+ // allocatable, in which case the value could be an unallocated
+ // allocatable (see Fortran 2018 7.5.10 point 7). The explicit
+ // convert would cause a segfault. Lowering will deal with
+ // conditionally converting and preserving the lower bounds in this
+ // case.
+ if (MaybeExpr converted{implicitConvertTo(
+ *symbol, std::move(*value), IsAllocatable(*symbol))}) {
if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
@@ -4180,7 +4205,12 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
Tristate isDefined{
semantics::IsDefinedAssignment(lhsType, lhsRank, rhsType, rhsRank)};
if (isDefined == Tristate::No) {
- if (lhsType && rhsType) {
+ // Make implicit conversion explicit, unless it is an assignment to a whole
+ // allocatable (the explicit conversion would prevent the propagation of the
+ // right hand side if it is a variable). Lowering will deal with the
+ // conversion in this case.
+ if (lhsType && rhsType &&
+ (!IsAllocatableDesignator(lhs) || context_.inWhereBody())) {
AddAssignmentConversion(*lhsType, *rhsType);
}
if (!fatalErrors_) {
diff --git a/flang/test/Lower/HLFIR/charconvert.f90 b/flang/test/Lower/HLFIR/charconvert.f90
index 9b9c8670077ddd5..9a0ad1e455128f7 100644
--- a/flang/test/Lower/HLFIR/charconvert.f90
+++ b/flang/test/Lower/HLFIR/charconvert.f90
@@ -19,10 +19,10 @@ end subroutine charconvert1
! CHECK: %[[C4_4:.*]] = arith.constant 4 : index
! CHECK: %[[VAL_38:.*]] = arith.divsi %[[VAL_37]], %[[C4_4]] : index
! CHECK: %[[VAL_39:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[ARG2]]) typeparams %[[VAL_38]] : (!fir.box<!fir.array<?x!fir.char<4,?>>>, index, index) -> !fir.boxchar<4>
+! CHECK: %[[VAL_42:.*]]:2 = fir.unboxchar %[[VAL_39]] : (!fir.boxchar<4>) -> (!fir.ref<!fir.char<4,?>>, index)
! CHECK: %[[C4_5:.*]] = arith.constant 4 : index
! CHECK: %[[VAL_40:.*]] = arith.muli %[[VAL_38]], %[[C4_5]] : index
! CHECK: %[[VAL_41:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_40]] : index)
-! CHECK: %[[VAL_42:.*]]:2 = fir.unboxchar %[[VAL_39]] : (!fir.boxchar<4>) -> (!fir.ref<!fir.char<4,?>>, index)
! CHECK: fir.char_convert %[[VAL_42]]#0 for %[[VAL_38:.*]] to %[[VAL_41]] : !fir.ref<!fir.char<4,?>>, index, !fir.ref<!fir.char<1,?>>
subroutine charconvert2(x)
@@ -63,9 +63,9 @@ subroutine charconvert3(c, c4)
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 {uniq_name = "_QFcharconvert3Ec4"} : (!fir.ref<!fir.char<4,?>>, index) -> (!fir.boxchar<4>, !fir.ref<!fir.char<4,?>>)
! CHECK: %[[VAL_4:.*]] = arith.addi %[[VAL_0]]#1, %[[VAL_0]]#1 : index
! CHECK: %[[VAL_5:.*]] = hlfir.concat %[[VAL_1]]#0, %[[VAL_1]]#0 len %[[VAL_4]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
-! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.char<4,?>(%[[VAL_4]] : index)
! CHECK: %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_5]] typeparams %[[VAL_4]] {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>, i1)
+! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.char<4,?>(%[[VAL_4]] : index)
! CHECK: fir.char_convert %[[VAL_7]]#1 for %[[VAL_4:.*]] to %[[VAL_6]] : !fir.ref<!fir.char<1,?>>, index, !fir.ref<!fir.char<4,?>>
! CHECK: hlfir.end_associate %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<!fir.char<1,?>>, i1
-! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]] typeparams %[[VAL_4]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.char<4,?>>, index) -> (!fir.boxchar<4>, !fir.ref<!fir.char<4,?>>)
-! CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_3]]#0 : !fir.boxchar<4>, !fir.boxchar<4>
\ No newline at end of file
+! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]] typeparams %[[VAL_4]] {uniq_name = ".temp.kindconvert"} : (!fir.ref<!fir.char<4,?>>, index) -> (!fir.boxchar<4>, !fir.ref<!fir.char<4,?>>)
+! CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_3]]#0 : !fir.boxchar<4>, !fir.boxchar<4>
diff --git a/flang/test/Lower/HLFIR/implicit-type-conversion-allocatable.f90 b/flang/test/Lower/HLFIR/implicit-type-conversion-allocatable.f90
new file mode 100644
index 000000000000000..7083a825dfd3b42
--- /dev/null
+++ b/flang/test/Lower/HLFIR/implicit-type-conversion-allocatable.f90
@@ -0,0 +1,40 @@
+! Test implicit conversion in assignment to whole allocatables. It
+! is special because care must be taken to propagate the RHS lower
+! bounds to the LHS in case of re-allocation.
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+subroutine preserve_lbounds(x, y)
+ integer, allocatable :: x(:)
+ complex, allocatable :: y(:)
+ x = y
+end subroutine
+! CHECK-LABEL: func.func @_QPpreserve_lbounds(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}uniq_name = "_QFpreserve_lboundsEx"
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}uniq_name = "_QFpreserve_lboundsEy"
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_8:.*]] = hlfir.elemental %[[VAL_7]] unordered : (!fir.shape<1>) -> !hlfir.expr<?xi32> {
+! CHECK: ^bb0(%[[VAL_9:.*]]: index):
+! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_10]] : (!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]]#0, %[[VAL_12]] : index
+! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_9]], %[[VAL_13]] : index
+! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_4]] (%[[VAL_14]]) : (!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>, index) -> !fir.ref<!fir.complex<4>>
+! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ref<!fir.complex<4>>
+! CHECK: %[[VAL_17:.*]] = fir.extract_value %[[VAL_16]], [0 : index] : (!fir.complex<4>) -> f32
+! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (f32) -> i32
+! CHECK: hlfir.yield_element %[[VAL_18]] : i32
+! CHECK: }
+! CHECK: %[[VAL_19:.*]]:3 = hlfir.associate %[[VAL_8]](%[[VAL_7]]) {uniq_name = ".tmp.keeplbounds"} : (!hlfir.expr<?xi32>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>, i1)
+! CHECK: %[[VAL_20:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_20]] : (!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_22:.*]] = fir.shape_shift %[[VAL_21]]#0, %[[VAL_6]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[VAL_23:.*]]:2 = hlfir.declare %[[VAL_19]]#1(%[[VAL_22]]) {uniq_name = ".tmp.keeplbounds"} : (!fir.ref<!fir.array<?xi32>>, !fir.shapeshift<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>)
+! CHECK: hlfir.assign %[[VAL_23]]#0 to %[[VAL_2]]#0 realloc : !fir.box<!fir.array<?xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: hlfir.end_associate %[[VAL_19]]#1, %[[VAL_19]]#2 : !fir.ref<!fir.array<?xi32>>, i1
+! CHECK: hlfir.destroy %[[VAL_8]] : !hlfir.expr<?xi32>
+! CHECK: return
+! CHECK: }
diff --git a/flang/test/Lower/charconvert.f90 b/flang/test/Lower/charconvert.f90
index 693d5bf60378864..c8ec254b6a541c2 100644
--- a/flang/test/Lower/charconvert.f90
+++ b/flang/test/Lower/charconvert.f90
@@ -29,4 +29,4 @@ subroutine test_c4_to_c1(c4, c1)
! CHECK: %[[VAL_4:.*]] = arith.muli %[[VAL_2]]#1, %[[C4]] : index
! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_4]] : index)
! CHECK: fir.char_convert %[[VAL_3]]#1 for %[[VAL_2]]#1 to %[[VAL_5:.*]] : !fir.ref<!fir.char<4,?>>, index, !fir.ref<!fir.char<1,?>>
-! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[VAL_2]]#1 {uniq_name = "ctor.temp"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
\ No newline at end of file
+! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] typeparams %[[VAL_2]]#1 {uniq_name = ".temp.kindconvert"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
More information about the flang-commits
mailing list