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 @@ -155,6 +155,21 @@ FirPlaceHolder::resultEntityPosition, Property::Value); } + void buildExplicitInterface( + const Fortran::evaluate::characteristics::Procedure &procedure) { + // Handle result + if (const std::optional + &result = procedure.functionResult) { + if (result->CanBeReturnedViaImplicitInterface()) + handleImplicitResult(*result); + else + handleExplicitResult(*result); + } else if (interface.side().hasAlternateReturns()) { + addFirResult(mlir::IndexType::get(&mlirContext), + FirPlaceHolder::resultEntityPosition, Property::Value); + } + } + private: void handleImplicitResult( const Fortran::evaluate::characteristics::FunctionResult &result) { @@ -182,6 +197,57 @@ } } + void handleExplicitResult( + const Fortran::evaluate::characteristics::FunctionResult &result) { + using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr; + + if (result.IsProcedurePointer()) + TODO(interface.converter.getCurrentLocation(), + "procedure pointer results"); + 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()); + fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape()); + if (!bounds.empty()) + mlirType = fir::SequenceType::get(bounds, mlirType); + if (result.attrs.test(Attr::Allocatable)) + mlirType = fir::BoxType::get(fir::HeapType::get(mlirType)); + if (result.attrs.test(Attr::Pointer)) + mlirType = fir::BoxType::get(fir::PointerType::get(mlirType)); + + addFirResult(mlirType, FirPlaceHolder::resultEntityPosition, + Property::Value); + } + + fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) { + fir::SequenceType::Shape bounds; + for (Fortran::evaluate::MaybeExtentExpr extentExpr : shape) { + fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent(); + if (std::optional constantExtent = + toInt64(std::move(extentExpr))) + extent = *constantExtent; + bounds.push_back(extent); + } + return bounds; + } + + template + std::optional toInt64(A &&expr) { + return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( + getConverter().getFoldingContext(), std::move(expr))); + } + void addFirResult(mlir::Type type, int entityPosition, Property p) { interface.outputs.emplace_back(FirPlaceHolder{type, entityPosition, p}); } @@ -201,7 +267,7 @@ if (isImplicit) impl.buildImplicitInterface(procedure); else - TODO_NOLOC("determineImplicitInterface"); + impl.buildExplicitInterface(procedure); } template diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -154,6 +154,17 @@ TypeBuilder(Fortran::lower::AbstractConverter &converter) : converter{converter}, context{&converter.getMLIRContext()} {} + template + void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) { + for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) { + fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent(); + if (std::optional constantExtent = + toInt64(std::move(extentExpr))) + extent = *constantExtent; + shape.push_back(extent); + } + } + template std::optional toInt64(A &&expr) { return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold( @@ -186,6 +197,15 @@ } else { fir::emitFatalError(loc, "symbol must have a type"); } + if (ultimate.IsObjectArray()) { + auto shapeExpr = Fortran::evaluate::GetShapeHelper{ + converter.getFoldingContext()}(ultimate); + if (!shapeExpr) + TODO(loc, "assumed rank symbol type lowering"); + fir::SequenceType::Shape shape; + translateShape(shape, std::move(*shapeExpr)); + ty = fir::SequenceType::get(shape, ty); + } if (Fortran::semantics::IsPointer(symbol)) return fir::BoxType::get(fir::PointerType::get(ty)); 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 @@ -48,6 +48,34 @@ ! CHECK: %{{.*}} = fir.call @_FortranAStopStatement ! CHECK: fir.unreachable +function fct_iarr1() + integer, dimension(10) :: fct_iarr1 +end + +! CHECK-LABEL: func @_QPfct_iarr1() -> !fir.array<10xi32> +! CHECK: return %{{.*}} : !fir.array<10xi32> + +function fct_iarr2() + integer, dimension(10, 20) :: fct_iarr2 +end + +! CHECK-LABEL: func @_QPfct_iarr2() -> !fir.array<10x20xi32> +! CHECK: return %{{.*}} : !fir.array<10x20xi32> + +function fct_iarr3() + integer, dimension(:, :), allocatable :: fct_iarr3 +end + +! CHECK-LABEL: func @_QPfct_iarr3() -> !fir.box>> +! CHECK: return %{{.*}} : !fir.box>> + +function fct_iarr4() + integer, dimension(:), pointer :: fct_iarr4 +end + +! CHECK-LABEL: func @_QPfct_iarr4() -> !fir.box>> +! CHECK: return %{{.*}} : !fir.box>> + logical(1) function lfct1() end ! CHECK-LABEL: func @_QPlfct1() -> !fir.logical<1>