diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -24,6 +24,7 @@ #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" #include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Support/FIRContext.h" #include "flang/Semantics/tools.h" @@ -248,13 +249,13 @@ using PassBy = Fortran::lower::CalleeInterface::PassEntityBy; auto mapPassedEntity = [&](const auto arg) -> void { if (arg.passBy == PassBy::AddressAndLength) { - // // TODO: now that fir call has some attributes regarding character - // // return, PassBy::AddressAndLength should be retired. - // mlir::Location loc = toLocation(); - // fir::factory::CharacterExprHelper charHelp{*builder, loc}; - // mlir::Value box = - // charHelp.createEmboxChar(arg.firArgument, arg.firLength); - // addSymbol(arg.entity->get(), box); + // TODO: now that fir call has some attributes regarding character + // return, PassBy::AddressAndLength should be retired. + mlir::Location loc = toLocation(); + fir::factory::CharacterExprHelper charHelp{*builder, loc}; + mlir::Value box = + charHelp.createEmboxChar(arg.firArgument, arg.firLength); + addSymbol(arg.entity->get(), box); } else { if (arg.entity.has_value()) { addSymbol(arg.entity->get(), arg.firArgument); @@ -444,7 +445,8 @@ } mlir::Value resultVal = resultSymBox.match( [&](const fir::CharBoxValue &x) -> mlir::Value { - TODO(loc, "Function return CharBoxValue"); + return fir::factory::CharacterExprHelper{*builder, loc} + .createEmboxChar(x.getBuffer(), x.getLen()); }, [&](const auto &) -> mlir::Value { mlir::Value resultRef = resultSymBox.getAddr(); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -443,6 +443,18 @@ return *arg; } +static const Fortran::evaluate::ActualArgument * +getResultEntity(const Fortran::evaluate::ProcedureRef &) { + return nullptr; +} + +static const Fortran::semantics::Symbol & +getResultEntity(Fortran::lower::pft::FunctionLikeUnit &funit) { + return funit.getSubprogramSymbol() + .get() + .result(); +} + //===----------------------------------------------------------------------===// // CallInterface implementation: this part is common to both caller and caller // sides. @@ -455,6 +467,7 @@ using CallInterface = Fortran::lower::CallInterface; using PassEntityBy = typename CallInterface::PassEntityBy; using PassedEntity = typename CallInterface::PassedEntity; + using FirValue = typename CallInterface::FirValue; using FortranEntity = typename CallInterface::FortranEntity; using FirPlaceHolder = typename CallInterface::FirPlaceHolder; using Property = typename CallInterface::Property; @@ -549,9 +562,9 @@ result.GetTypeAndShape(); assert(typeAndShape && "expect type for non proc pointer result"); Fortran::evaluate::DynamicType dynamicType = typeAndShape->type(); + // Character result allocated by caller and passed as hidden arguments if (dynamicType.category() == Fortran::common::TypeCategory::Character) { - TODO(interface.converter.getCurrentLocation(), - "implicit result character type"); + handleImplicitCharacterResult(dynamicType); } else if (dynamicType.category() == Fortran::common::TypeCategory::Derived) { TODO(interface.converter.getCurrentLocation(), @@ -566,6 +579,24 @@ } } + void + handleImplicitCharacterResult(const Fortran::evaluate::DynamicType &type) { + int resultPosition = FirPlaceHolder::resultEntityPosition; + setPassedResult(PassEntityBy::AddressAndLength, + getResultEntity(interface.side().getCallDescription())); + mlir::Type lenTy = mlir::IndexType::get(&mlirContext); + std::optional constantLen = type.knownLength(); + fir::CharacterType::LenType len = + constantLen ? *constantLen : fir::CharacterType::unknownLen(); + mlir::Type charRefTy = fir::ReferenceType::get( + fir::CharacterType::get(&mlirContext, type.kind(), len)); + mlir::Type boxCharTy = fir::BoxCharType::get(&mlirContext, type.kind()); + addFirOperand(charRefTy, resultPosition, Property::CharAddress); + addFirOperand(lenTy, resultPosition, Property::CharLength); + /// For now, also return it by boxchar + addFirResult(boxCharTy, resultPosition, Property::BoxChar); + } + void handleExplicitResult( const Fortran::evaluate::characteristics::FunctionResult &result) { using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr; @@ -576,17 +607,7 @@ const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape = result.GetTypeAndShape(); assert(typeAndShape && "expect type for non proc pointer result"); - Fortran::evaluate::DynamicType dynamicType = typeAndShape->type(); - if (dynamicType.category() == Fortran::common::TypeCategory::Character) { - TODO(interface.converter.getCurrentLocation(), - "implicit result character type"); - } else if (dynamicType.category() == - Fortran::common::TypeCategory::Derived) { - TODO(interface.converter.getCurrentLocation(), - "implicit result derived type"); - } - mlir::Type mlirType = - getConverter().genType(dynamicType.category(), dynamicType.kind()); + mlir::Type mlirType = translateDynamicType(typeAndShape->type()); fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape()); if (!bounds.empty()) mlirType = fir::SequenceType::get(bounds, mlirType); @@ -595,8 +616,21 @@ if (result.attrs.test(Attr::Pointer)) mlirType = fir::BoxType::get(fir::PointerType::get(mlirType)); + if (fir::isa_char(mlirType)) { + // Character scalar results must be passed as arguments in lowering so + // that an assumed length character function callee can access the result + // length. A function with a result requiring an explicit interface does + // not have to be compatible with assumed length function, but most + // compilers supports it. + handleImplicitCharacterResult(typeAndShape->type()); + return; + } + addFirResult(mlirType, FirPlaceHolder::resultEntityPosition, Property::Value); + // Explicit results require the caller to allocate the storage and save the + // function result in the storage with a fir.save_result. + setSaveResult(); } fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) { @@ -817,8 +851,21 @@ interface.passedArguments.emplace_back( PassedEntity{p, entity, {}, {}, characteristics}); } + void setPassedResult(PassEntityBy p, FortranEntity entity) { + interface.passedResult = + PassedEntity{p, entity, emptyValue(), emptyValue()}; + } + void setSaveResult() { interface.saveResult = true; } int nextPassedArgPosition() { return interface.passedArguments.size(); } + static FirValue emptyValue() { + if constexpr (std::is_same_v) { + return {}; + } else { + return -1; + } + } + Fortran::lower::AbstractConverter &getConverter() { return interface.converter; } diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -301,7 +301,25 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::ScalarStaticChar &x) { - TODO(loc, "ScalarStaticChar variable lowering"); + // type is a CHARACTER, determine the LEN value + auto charLen = x.charLen(); + if (replace) { + Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); + std::pair unboxchar = + charHelp.createUnboxChar(symBox.getAddr()); + mlir::Value boxAddr = unboxchar.first; + // Set/override LEN with a constant + mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen); + symMap.addCharSymbol(sym, boxAddr, len, true); + return; + } + mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen); + if (preAlloc) { + symMap.addCharSymbol(sym, preAlloc, len); + return; + } + mlir::Value local = createNewLocal(converter, loc, var, preAlloc); + symMap.addCharSymbol(sym, local, len); }, //===--------------------------------------------------------------===// diff --git a/flang/test/Lower/basic-function.f90 b/flang/test/Lower/basic-function.f90 --- a/flang/test/Lower/basic-function.f90 +++ b/flang/test/Lower/basic-function.f90 @@ -141,3 +141,10 @@ end ! CHECK-LABEL: func @_QPcplxfct6() -> !fir.complex<16> ! CHECK: return %{{.*}} : !fir.complex<16> + +function fct_with_character_return(i) + character(10) :: fct_with_character_return + integer :: i +end +! CHECK-LABEL: func @_QPfct_with_character_return( +! CHECK-SAME: %{{.*}}: !fir.ref>{{.*}}, %{{.*}}: index{{.*}}, %{{.*}}: !fir.ref{{.*}}) -> !fir.boxchar<1> {