diff --git a/flang/include/flang/Lower/BoxAnalyzer.h b/flang/include/flang/Lower/BoxAnalyzer.h index 3b8e2455ff273..52cded8b219d8 100644 --- a/flang/include/flang/Lower/BoxAnalyzer.h +++ b/flang/include/flang/Lower/BoxAnalyzer.h @@ -382,8 +382,6 @@ class BoxAnalyzer : public fir::details::matcher { /// Run the analysis on `sym`. void analyze(const Fortran::semantics::Symbol &sym) { - if (Fortran::semantics::IsProcedurePointer(sym)) - return; if (symIsArray(sym)) { bool isConstant = !isAssumedSize(sym); llvm::SmallVector lbounds; diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h index c7dca4f8f1348..579bdcfd89887 100644 --- a/flang/include/flang/Lower/CallInterface.h +++ b/flang/include/flang/Lower/CallInterface.h @@ -111,8 +111,7 @@ class CallInterface { CharBoxValueAttribute, // BoxChar with VALUE // Passing a character procedure as a // tuple. - CharProcTuple, - BoxProcRef + CharProcTuple }; /// Different properties of an entity that can be passed/returned. /// One-to-One mapping with PassEntityBy but for @@ -125,8 +124,7 @@ class CallInterface { CharProcTuple, Box, MutableBox, - Value, - BoxProcRef + Value }; using FortranEntity = typename PassedEntityTypes::FortranEntity; diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h index ae772c52e425b..86a757a9aadf4 100644 --- a/flang/include/flang/Lower/ConvertProcedureDesignator.h +++ b/flang/include/flang/Lower/ConvertProcedureDesignator.h @@ -19,8 +19,6 @@ namespace mlir { class Location; -class Value; -class Type; } namespace fir { class ExtendedValue; @@ -31,9 +29,6 @@ class EntityWithAttributes; namespace Fortran::evaluate { struct ProcedureDesignator; } -namespace Fortran::semantics { -class Symbol; -} namespace Fortran::lower { class AbstractConverter; @@ -55,10 +50,5 @@ hlfir::EntityWithAttributes convertProcedureDesignatorToHLFIR( const Fortran::evaluate::ProcedureDesignator &proc, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx); -/// Generate initialization for procedure pointer to procedure target. -mlir::Value -convertProcedureDesignatorInitialTarget(Fortran::lower::AbstractConverter &, - mlir::Location, - const Fortran::semantics::Symbol &sym); } // namespace Fortran::lower #endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h index b5b2c99810b15..0b36186d68a46 100644 --- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -677,10 +677,6 @@ mlir::Value genCPtrOrCFunptrValue(fir::FirOpBuilder &builder, /// to keep all the lower bound and explicit parameter information. fir::BoxValue createBoxValue(fir::FirOpBuilder &builder, mlir::Location loc, const fir::ExtendedValue &exv); - -/// Generate Null BoxProc for procedure pointer null initialization. -mlir::Value createNullBoxProc(fir::FirOpBuilder &builder, mlir::Location loc, - mlir::Type boxType); } // namespace fir::factory #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h index 999ac9c7a42fa..07bb380320bf7 100644 --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -58,9 +58,6 @@ class Entity : public mlir::Value { bool isValue() const { return isFortranValue(*this); } bool isVariable() const { return !isValue(); } bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); } - bool isProcedurePointer() const { - return hlfir::isBoxProcAddressType(getType()); - } bool isBoxAddressOrValue() const { return hlfir::isBoxAddressOrValueType(getType()); } diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h index e8f2848529827..aa68d0811c486 100644 --- a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h +++ b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h @@ -67,12 +67,6 @@ inline bool isBoxAddressType(mlir::Type type) { return type && type.isa(); } -/// Is this a fir.boxproc address type? -inline bool isBoxProcAddressType(mlir::Type type) { - type = fir::dyn_cast_ptrEleTy(type); - return type && type.isa(); -} - /// Is this a fir.box or fir.class address or value type? inline bool isBoxAddressOrValueType(mlir::Type type) { return fir::unwrapRefType(type).isa(); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 23c48cc7bd978..872bf6bc729ec 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3095,17 +3095,6 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::lower::SomeExpr *expr = Fortran::semantics::GetExpr(pointerObject); assert(expr); - if (Fortran::evaluate::IsProcedurePointer(*expr)) { - Fortran::lower::StatementContext stmtCtx; - hlfir::Entity pptr = Fortran::lower::convertExprToHLFIR( - loc, *this, *expr, localSymbols, stmtCtx); - auto boxTy{ - Fortran::lower::getUntypedBoxProcType(builder->getContext())}; - hlfir::Entity nullBoxProc( - fir::factory::createNullBoxProc(*builder, loc, boxTy)); - builder->createStoreWithConvert(loc, nullBoxProc, pptr); - return; - } fir::MutableBoxValue box = genExprMutableBox(loc, *expr); fir::factory::disassociateMutableBox(*builder, loc, box); } @@ -3252,24 +3241,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Location loc, const Fortran::evaluate::Assignment &assign, const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) { Fortran::lower::StatementContext stmtCtx; - - if (!lowerToHighLevelFIR() && Fortran::evaluate::IsProcedure(assign.rhs)) + if (Fortran::evaluate::IsProcedure(assign.rhs)) TODO(loc, "procedure pointer assignment"); - if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) { - hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR( - loc, *this, assign.lhs, localSymbols, stmtCtx); - if (Fortran::evaluate::IsNullProcedurePointer(assign.rhs)) { - auto boxTy{Fortran::lower::getUntypedBoxProcType(&getMLIRContext())}; - hlfir::Entity rhs( - fir::factory::createNullBoxProc(*builder, loc, boxTy)); - builder->createStoreWithConvert(loc, rhs, lhs); - return; - } - hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress( - loc, *this, assign.rhs, localSymbols, stmtCtx))); - builder->createStoreWithConvert(loc, rhs, lhs); - return; - } std::optional lhsType = assign.lhs.GetType(); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index b1420dcb25a11..51b0579fac36c 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -23,10 +23,6 @@ #include "flang/Semantics/tools.h" #include -static mlir::FunctionType -getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc, - Fortran::lower::AbstractConverter &converter); - mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) { llvm::SmallVector resultTys; llvm::SmallVector inputTys; @@ -1059,24 +1055,15 @@ class Fortran::lower::CallInterfaceImpl { const DummyCharacteristics *characteristics, const Fortran::evaluate::characteristics::DummyProcedure &proc, const FortranEntity &entity) { - if (!interface.converter.getLoweringOptions().getLowerToHighLevelFIR() && - proc.attrs.test( + if (proc.attrs.test( Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer)) TODO(interface.converter.getCurrentLocation(), "procedure pointer arguments"); + // Otherwise, it is a dummy procedure. const Fortran::evaluate::characteristics::Procedure &procedure = proc.procedure.value(); mlir::Type funcType = getProcedureDesignatorType(&procedure, interface.converter); - if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure:: - Attr::Pointer)) { - // Prodecure pointer dummy argument. - funcType = fir::ReferenceType::get(funcType); - addFirOperand(funcType, nextPassedArgPosition(), Property::BoxProcRef); - addPassedArg(PassEntityBy::BoxProcRef, entity, characteristics); - return; - } - // Otherwise, it is a dummy procedure. std::optional resultTy = getResultDynamicType(procedure); if (resultTy && mustPassLengthWithDummyProcedure(procedure)) { @@ -1100,40 +1087,37 @@ class Fortran::lower::CallInterfaceImpl { void handleExplicitResult( const Fortran::evaluate::characteristics::FunctionResult &result) { using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr; - mlir::Type mlirType; - if (auto proc{result.IsProcedurePointer()}) - mlirType = fir::BoxProcType::get( - &mlirContext, getProcedureType(*proc, interface.converter)); - else { - const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape = - result.GetTypeAndShape(); - assert(typeAndShape && "expect type for non proc pointer result"); - mlirType = translateDynamicType(typeAndShape->type()); - fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape()); - const auto *resTypeAndShape{result.GetTypeAndShape()}; - bool resIsPolymorphic = - resTypeAndShape && resTypeAndShape->type().IsPolymorphic(); - bool resIsAssumedType = - resTypeAndShape && resTypeAndShape->type().IsAssumedType(); - if (!bounds.empty()) - mlirType = fir::SequenceType::get(bounds, mlirType); - if (result.attrs.test(Attr::Allocatable)) - mlirType = fir::wrapInClassOrBoxType( - fir::HeapType::get(mlirType), resIsPolymorphic, resIsAssumedType); - if (result.attrs.test(Attr::Pointer)) - mlirType = - fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType), - resIsPolymorphic, resIsAssumedType); - - 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; - } + + 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"); + mlir::Type mlirType = translateDynamicType(typeAndShape->type()); + fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape()); + const auto *resTypeAndShape{result.GetTypeAndShape()}; + bool resIsPolymorphic = + resTypeAndShape && resTypeAndShape->type().IsPolymorphic(); + bool resIsAssumedType = + resTypeAndShape && resTypeAndShape->type().IsAssumedType(); + if (!bounds.empty()) + mlirType = fir::SequenceType::get(bounds, mlirType); + if (result.attrs.test(Attr::Allocatable)) + mlirType = fir::wrapInClassOrBoxType(fir::HeapType::get(mlirType), + resIsPolymorphic, resIsAssumedType); + if (result.attrs.test(Attr::Pointer)) + mlirType = fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType), + resIsPolymorphic, resIsAssumedType); + + 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, @@ -1550,10 +1534,3 @@ bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) { return ty.isa() && fir::isa_integer(fir::unwrapRefType(ty)); } - -// Return the mlir::FunctionType of a procedure -static mlir::FunctionType -getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc, - Fortran::lower::AbstractConverter &converter) { - return SignatureBuilder{proc, converter, false}.genFunctionType(); -} diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 395a98b43d537..82e1ece4efeaf 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -175,10 +175,6 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult( std::tie(funcPointer, charFuncPointerLength) = fir::factory::extractCharacterProcedureTuple(builder, loc, funcPointer); - // Reference to a procedure pointer. Load its value, the address of the - // procedure it points to. - if (Fortran::semantics::IsProcedurePointer(sym)) - funcPointer = builder.create(loc, funcPointer); } mlir::IndexType idxTy = builder.getIndexType(); @@ -874,39 +870,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( // element if this is an array in an elemental call. hlfir::Entity actual = preparedActual.getActual(loc, builder); - // Handle the procedure pointer actual arguments. - if (actual.isProcedurePointer()) { - // Procedure pointer actual to procedure pointer dummy. - if (hlfir::isBoxProcAddressType(dummyType)) - return PreparedDummyArgument{actual, /*cleanups=*/{}}; - // Procedure pointer actual to procedure dummy. - if (hlfir::isFortranProcedureValue(dummyType)) { - actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); - return PreparedDummyArgument{actual, /*cleanups=*/{}}; - } - } - - // NULL() actual to procedure pointer dummy - if (Fortran::evaluate::IsNullProcedurePointer(expr) && - hlfir::isBoxProcAddressType(dummyType)) { - auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())}; - auto tempBoxProc{builder.createTemporary(loc, boxTy)}; - hlfir::Entity nullBoxProc( - fir::factory::createNullBoxProc(builder, loc, boxTy)); - builder.create(loc, nullBoxProc, tempBoxProc); - return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}}; - } - + // Do nothing if this is a procedure argument. It is already a + // fir.boxproc/fir.tuple as it should. if (actual.isProcedure()) { - // Procedure actual to procedure pointer dummy. - if (hlfir::isBoxProcAddressType(dummyType)) { - auto tempBoxProc{builder.createTemporary(loc, actual.getType())}; - builder.create(loc, actual, tempBoxProc); - return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}}; - } - // Procedure actual to procedure dummy. - // Do nothing if this is a procedure argument. It is already a - // fir.boxproc/fir.tuple as it should. if (actual.getType() != dummyType) actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType); return PreparedDummyArgument{actual, /*cleanups=*/{}}; @@ -1192,7 +1158,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals, case PassBy::CharBoxValueAttribute: case PassBy::Box: case PassBy::BaseAddress: - case PassBy::BoxProcRef: case PassBy::BoxChar: { PreparedDummyArgument preparedDummy = prepareUserCallActualArgument(loc, builder, *preparedActual, argTy, @@ -1209,8 +1174,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals, break; case PassBy::CharProcTuple: { hlfir::Entity actual = preparedActual->getActual(loc, builder); - if (actual.isProcedurePointer()) - actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); if (!fir::isCharacterProcedureTuple(actual.getType())) actual = fixProcedureDummyMismatch(loc, builder, actual, argTy); caller.placeInput(arg, actual); @@ -1532,8 +1495,6 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, } hlfir::Entity actual = arg.value()->getActual(loc, builder); - if (actual.isProcedurePointer()) - TODO(loc, "Procedure pointer as actual argument to intrinsics."); switch (argRules.lowerAs) { case fir::LowerIntrinsicArgAs::Value: operands.emplace_back( @@ -2188,10 +2149,8 @@ genProcedureRef(CallContext &callContext) { TODO(loc, "assumed type actual argument"); if (Fortran::evaluate::UnwrapExpr( *expr)) { - if ((arg.passBy != - Fortran::lower::CallerInterface::PassEntityBy::MutableBox) && - (arg.passBy != - Fortran::lower::CallerInterface::PassEntityBy::BoxProcRef)) { + if (arg.passBy != + Fortran::lower::CallerInterface::PassEntityBy::MutableBox) { assert( arg.isOptional() && "NULL must be passed only to pointer, allocatable, or OPTIONAL"); diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index da2b32ac82268..8c2318632f725 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -4845,9 +4845,6 @@ class ArrayExprLowering { } // See C15100 and C15101 fir::emitFatalError(loc, "cannot be POINTER, ALLOCATABLE"); - case PassBy::BoxProcRef: - // Procedure pointer: no action here. - break; } } diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index b114fbe1a13a2..5a51493c9aaa5 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -1425,9 +1425,7 @@ class HlfirBuilder { } hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) { - TODO( - getLoc(), - "lowering function references that return procedure pointers to HLFIR"); + TODO(getLoc(), "lowering ProcRef to HLFIR"); } template diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp index 84e04b0a65f44..20ade1a04049f 100644 --- a/flang/lib/Lower/ConvertProcedureDesignator.cpp +++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp @@ -11,13 +11,11 @@ #include "flang/Lower/AbstractConverter.h" #include "flang/Lower/CallInterface.h" #include "flang/Lower/ConvertCall.h" -#include "flang/Lower/ConvertExprToHLFIR.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/Support/Utils.h" #include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/IntrinsicCall.h" -#include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIROps.h" static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr, @@ -100,15 +98,6 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR( mlir::Location loc, Fortran::lower::AbstractConverter &converter, const Fortran::evaluate::ProcedureDesignator &proc, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) { - const auto *sym = proc.GetSymbol(); - if (sym) { - if (sym->GetUltimate().attrs().test(Fortran::semantics::Attr::INTRINSIC)) - TODO(loc, "Procedure pointer with intrinsic target."); - if (std::optional varDef = - symMap.lookupVariableDefinition(*sym)) - return *varDef; - } - fir::ExtendedValue procExv = convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx); // Directly package the procedure address as a fir.boxproc or @@ -136,15 +125,3 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR( [funcAddr](const auto &) { return funcAddr; }); return hlfir::EntityWithAttributes{res}; } - -mlir::Value Fortran::lower::convertProcedureDesignatorInitialTarget( - Fortran::lower::AbstractConverter &converter, mlir::Location loc, - const Fortran::semantics::Symbol &sym) { - Fortran::lower::SymMap globalOpSymMap; - Fortran::lower::StatementContext stmtCtx; - Fortran::evaluate::ProcedureDesignator proc(sym); - auto procVal{Fortran::lower::convertProcedureDesignatorToHLFIR( - loc, converter, proc, globalOpSymMap, stmtCtx)}; - return fir::getBase(Fortran::lower::convertToAddress( - loc, converter, procVal, stmtCtx, procVal.getType())); -} diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index 72f1ee7a2cb2b..1ed3b602621b4 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -248,13 +248,8 @@ struct TypeBuilderImpl { // links, the fir type is built based on the ultimate symbol. This relies // on the fact volatile and asynchronous are not reflected in fir types. const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate(); - - if (Fortran::semantics::IsProcedurePointer(ultimate)) { - Fortran::evaluate::ProcedureDesignator proc(ultimate); - auto procTy{Fortran::lower::translateSignature(proc, converter)}; - return fir::BoxProcType::get(context, procTy); - } - + if (Fortran::semantics::IsProcedurePointer(ultimate)) + TODO(loc, "procedure pointers"); if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) { if (const Fortran::semantics::IntrinsicTypeSpec *tySpec = type->AsIntrinsic()) { diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index d4f738e5dae11..e8137886d2cf5 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -18,7 +18,6 @@ #include "flang/Lower/ConvertConstant.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertExprToHLFIR.h" -#include "flang/Lower/ConvertProcedureDesignator.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/StatementContext.h" @@ -480,8 +479,7 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter, if (global && globalIsInitialized(global)) return global; - if (!converter.getLoweringOptions().getLowerToHighLevelFIR() && - Fortran::semantics::IsProcedurePointer(sym)) + if (Fortran::semantics::IsProcedurePointer(sym)) TODO(loc, "procedure pointer globals"); // If this is an array, check to see if we can use a dense attribute @@ -509,8 +507,7 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter, if (!global) global = builder.createGlobal(loc, symTy, globalName, linkage, mlir::Attribute{}, isConst, var.isTarget()); - if (Fortran::semantics::IsAllocatableOrPointer(sym) && - !Fortran::semantics::IsProcedure(sym)) { + if (Fortran::semantics::IsAllocatableOrPointer(sym)) { const auto *details = sym.detailsIf(); if (details && details->init()) { @@ -530,6 +527,7 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter, b.create(loc, box); }); } + } else if (const auto *details = sym.detailsIf()) { if (details->init()) { @@ -554,39 +552,10 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter, builder.create(loc, castTo); }); } - } else if (Fortran::semantics::IsProcedurePointer(sym)) { - const auto *details{sym.detailsIf()}; - if (details && details->init()) { - auto sym{*details->init()}; - if (sym) // Has a procedure target. - Fortran::lower::createGlobalInitialization( - builder, global, [&](fir::FirOpBuilder &b) { - Fortran::lower::StatementContext stmtCtx( - /*cleanupProhibited=*/true); - auto box{Fortran::lower::convertProcedureDesignatorInitialTarget( - converter, loc, *sym)}; - auto castTo{builder.createConvert(loc, symTy, box)}; - b.create(loc, castTo); - }); - else { // Has NULL() target. - Fortran::lower::createGlobalInitialization( - builder, global, [&](fir::FirOpBuilder &b) { - auto box{fir::factory::createNullBoxProc(b, loc, symTy)}; - b.create(loc, box); - }); - } - } else { - // No initialization. - Fortran::lower::createGlobalInitialization( - builder, global, [&](fir::FirOpBuilder &b) { - auto box{fir::factory::createNullBoxProc(b, loc, symTy)}; - b.create(loc, box); - }); - } } else if (sym.has()) { mlir::emitError(loc, "COMMON symbol processed elsewhere"); } else { - TODO(loc, "global"); // Something else + TODO(loc, "global"); // Procedure pointer or something else } // Creates zero initializer for globals without initializers, this is a common // and expected behavior (although not required by the standard) @@ -676,16 +645,8 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter, var.getSymbol().GetUltimate(); llvm::StringRef symNm = toStringRef(ultimateSymbol.name()); bool isTarg = var.isTarget(); - // Let the builder do all the heavy lifting. - if (!Fortran::semantics::IsProcedurePointer(ultimateSymbol)) - return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg); - - // Local procedure pointer. - auto res{builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg)}; - auto box{fir::factory::createNullBoxProc(builder, loc, ty)}; - builder.create(loc, box, res); - return res; + return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg); } /// Must \p var be default initialized at runtime when entering its scope. @@ -1581,8 +1542,7 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter, // is useful to maintain the address of the commonblock in an MLIR value and // query it. hlfir.declare need not be created for these. if (converter.getLoweringOptions().getLowerToHighLevelFIR() && - (!Fortran::semantics::IsProcedure(sym) || - Fortran::semantics::IsPointer(sym)) && + !Fortran::semantics::IsProcedure(sym) && !sym.detailsIf()) { bool isCrayPointee = sym.test(Fortran::semantics::Symbol::Flag::CrayPointee); @@ -1727,16 +1687,6 @@ genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter, /*lbounds=*/std::nullopt, force); } -/// Map a procedure pointer -static void genProcPointer(Fortran::lower::AbstractConverter &converter, - Fortran::lower::SymMap &symMap, - const Fortran::semantics::Symbol &sym, - mlir::Value addr, bool force = false) { - genDeclareSymbol(converter, symMap, sym, addr, mlir::Value{}, - /*shape=*/std::nullopt, - /*lbounds=*/std::nullopt, force); -} - /// Map a symbol represented with a runtime descriptor to its FIR fir.box and /// evaluated specification expressions. Will optionally create fir.declare. static void genBoxDeclare(Fortran::lower::AbstractConverter &converter, @@ -1788,20 +1738,8 @@ void Fortran::lower::mapSymbolAttributes( Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp); } - - // Procedure pointer. - if (Fortran::semantics::IsPointer(sym)) { - // global - mlir::Value boxAlloc = preAlloc; - // dummy or passed result - if (!boxAlloc) - if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym)) - boxAlloc = symbox.getAddr(); - // local - if (!boxAlloc) - boxAlloc = createNewLocal(converter, loc, var, preAlloc); - genProcPointer(converter, symMap, sym, boxAlloc, replace); - } + if (Fortran::semantics::IsPointer(sym)) + TODO(loc, "procedure pointers"); return; } diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp index df42dc8a3d0c8..c6d632036c82e 100644 --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -1516,14 +1516,3 @@ mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder, fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy); return builder.create(loc, cPtrAddr); } - -mlir::Value fir::factory::createNullBoxProc(fir::FirOpBuilder &builder, - mlir::Location loc, - mlir::Type boxType) { - auto boxTy{boxType.dyn_cast()}; - if (!boxTy) - fir::emitFatalError(loc, "Procedure pointer must be of BoxProcType"); - auto boxEleTy{fir::unwrapRefType(boxTy.getEleTy())}; - mlir::Value initVal{builder.create(loc, boxEleTy)}; - return builder.create(loc, boxTy, initVal); -} diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp index 88d3f15deb9b3..3d0a59b468ba7 100644 --- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp +++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp @@ -696,8 +696,6 @@ hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc, // or fir.class to hold bounds, dynamic type or length parameter // information. Keep them boxed. return boxLoad; - } else if (entity.isProcedurePointer()) { - return hlfir::Entity{builder.create(loc, entity)}; } return entity; } diff --git a/flang/test/Lower/HLFIR/procedure-pointer.f90 b/flang/test/Lower/HLFIR/procedure-pointer.f90 deleted file mode 100644 index 12bb7c67cd2d4..0000000000000 --- a/flang/test/Lower/HLFIR/procedure-pointer.f90 +++ /dev/null @@ -1,285 +0,0 @@ -! test level 1 procedure pointer for -! 1. declaration and initialization -! 2. pointer assignment and invocation -! 3. procedure pointer argument passing. -! RUN: bbc -emit-hlfir -o - %s | FileCheck %s - -module m - interface - real function real_func(x) - real :: x - end function - character(:) function char_func(x) - pointer :: char_func - integer :: x - end function - subroutine sub(x) - real :: x - end subroutine - subroutine foo2(q) - import - procedure(char_func), pointer :: q - end - end interface - -end module m - -!!! Testing declaration and initialization -subroutine sub1() -use m - procedure(real_func), pointer :: p1 -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> f32> {bindc_name = "p1", uniq_name = "_QFsub1Ep1"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref) -> f32 -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref) -> f32>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep1"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) - - procedure(real_func), pointer :: p2 => null() -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub1Ep2) : !fir.ref) -> f32>> -! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep2"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) - - procedure(real_func), pointer :: p3 => real_func -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub1Ep3) : !fir.ref) -> f32>> -! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep3"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) - - procedure(), pointer :: p4 -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<() -> ()> {bindc_name = "p4", uniq_name = "_QFsub1Ep4"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits () -> () -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : (() -> ()) -> !fir.boxproc<() -> ()> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref ()>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep4"} : (!fir.ref ()>>) -> (!fir.ref ()>>, !fir.ref ()>>) - - procedure(real), pointer :: p5 -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<() -> f32> {bindc_name = "p5", uniq_name = "_QFsub1Ep5"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits () -> f32 -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : (() -> f32) -> !fir.boxproc<() -> f32> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref f32>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep5"} : (!fir.ref f32>>) -> (!fir.ref f32>>, !fir.ref f32>>) - - procedure(char_func), pointer :: p6 -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> !fir.box>>> {bindc_name = "p6", uniq_name = "_QFsub1Ep6"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref) -> !fir.box>> -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref) -> !fir.box>>) -> !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref) -> !fir.box>>>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep6"} : (!fir.ref) -> !fir.box>>>>) -> (!fir.ref) -> !fir.box>>>>, !fir.ref) -> !fir.box>>>>) - - procedure(char_func), pointer :: p7 => char_func -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub1Ep7) : !fir.ref) -> !fir.box>>>> -! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub1Ep7"} : (!fir.ref) -> !fir.box>>>>) -> (!fir.ref) -> !fir.box>>>>, !fir.ref) -> !fir.box>>>>) -end subroutine sub1 - - -!!! Testing pointer assignment and invocation -subroutine sub2() -use m - procedure(real_func), pointer :: p1 - - p1 => null() -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> f32> {bindc_name = "p1", uniq_name = "_QFsub2Ep1"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref) -> f32 -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref) -> f32>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub2Ep1"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) -! CHECK: %[[VAL_4:.*]] = fir.zero_bits () -> () -! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : (() -> ()) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref) -> f32>> -end subroutine - -subroutine sub3() -use m - procedure(real_func), pointer :: p1 - real :: res, r - - p1 => real_func -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> f32> {bindc_name = "p1", uniq_name = "_QFsub3Ep1"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref) -> f32 -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref) -> f32>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub3Ep1"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) -! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPreal_func) : (!fir.ref) -> f32 -! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref) -> f32>> - - res = p1(r) -! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref) -> f32>> -! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.boxproc<(!fir.ref) -> f32>) -> ((!fir.ref) -> f32) -! CHECK: %[[VAL_9:.*]] = fir.call %[[VAL_8]](%5#1) fastmath : (!fir.ref) -> f32 - - nullify(p1) -! CHECK: %[[VAL_10:.*]] = fir.zero_bits () -> () -! CHECK: %[[VAL_11:.*]] = fir.emboxproc %[[VAL_10]] : (() -> ()) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_12]] to %[[VAL_3]]#0 : !fir.ref) -> f32>> -end subroutine - -subroutine sub4() -use m - procedure(char_func), pointer :: p2 - character(:), pointer :: res - integer :: i - - p2 => char_func -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> !fir.box>>> {bindc_name = "p2", uniq_name = "_QFsub4Ep2"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref) -> !fir.box>> -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref) -> !fir.box>>) -> !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref) -> !fir.box>>>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub4Ep2"} : (!fir.ref) -> !fir.box>>>>) -> (!fir.ref) -> !fir.box>>>>, !fir.ref) -> !fir.box>>>>) -! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPchar_func) : (!fir.ref) -> !fir.box>> -! CHECK: %[[VAL_12:.*]] = arith.constant -1 : index -! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref) -> !fir.box>>) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_12]] : (index) -> i64 -! CHECK: %[[VAL_7:.*]] = fir.undefined tuple ()>, i64> -! CHECK: %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_5]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> -! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_6]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> -! CHECK: %[[VAL_10:.*]] = fir.extract_value %[[VAL_9]], [0 : index] : (tuple ()>, i64>) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: fir.store %[[VAL_11]] to %[[VAL_3]]#0 : !fir.ref) -> !fir.box>>>> - - res = p2(i) -! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref) -> !fir.box>>>> -! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_12]] : (!fir.boxproc<(!fir.ref) -> !fir.box>>>) -> ((!fir.ref) -> !fir.box>>) -! CHECK: %[[VAL_14:.*]] = fir.call %[[VAL_13]](%2#1) fastmath : (!fir.ref) -> !fir.box>> -end subroutine - -subroutine sub5() -use m - procedure(real), pointer :: p3 - - p3 => real_func -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<() -> f32> {bindc_name = "p3", uniq_name = "_QFsub5Ep3"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits () -> f32 -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : (() -> f32) -> !fir.boxproc<() -> f32> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref f32>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub5Ep3"} : (!fir.ref f32>>) -> (!fir.ref f32>>, !fir.ref f32>>) -! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPreal_func) : (!fir.ref) -> f32 -! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<() -> f32> -! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref f32>> -end subroutine - -subroutine sub6() -use m - procedure(), pointer :: p4 - real :: r - - p4 => sub -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<() -> ()> {bindc_name = "p4", uniq_name = "_QFsub6Ep4"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits () -> () -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : (() -> ()) -> !fir.boxproc<() -> ()> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref ()>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub6Ep4"} : (!fir.ref ()>>) -> (!fir.ref ()>>, !fir.ref ()>>) -! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPsub) : (!fir.ref) -> () -! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref) -> ()) -> !fir.boxproc<() -> ()> -! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]]#0 : !fir.ref ()>> - - call p4(r) -! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref ()>> -! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref) -> ()) -! CHECK: fir.call %[[VAL_7]](%5#1) fastmath : (!fir.ref) -> () -end subroutine - - -!!! Testing pointer assignment and invocation -subroutine sub7(p1, p2) -use m - procedure(real_func), pointer :: p1 -! CHECK: %[[VAL_0:.*]]:2 = hlfir.declare %arg0 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub7Ep1"} : (!fir.ref ()>>) -> (!fir.ref ()>>, !fir.ref ()>>) - - procedure(char_func), pointer :: p2 -! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %arg1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub7Ep2"} : (!fir.ref ()>>) -> (!fir.ref ()>>, !fir.ref ()>>) - - call foo1(p1) -! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]]#0 : !fir.ref ()>> -! CHECK: fir.call @_QPfoo1(%[[VAL_2]]) fastmath : (!fir.boxproc<() -> ()>) -> () - - call foo2(p2) -! CHECK: fir.call @_QPfoo2(%[[VAL_1]]#0) fastmath : (!fir.ref ()>>) -> () -end - -subroutine sub8() -use m - procedure(real_func), pointer, save :: pp1 -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub8Epp1) : !fir.ref) -> f32>> -! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub8Epp1"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) - - procedure(char_func), pointer, save :: pp2 -! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFsub8Epp2) : !fir.ref) -> !fir.box>>>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub8Epp2"} : (!fir.ref) -> !fir.box>>>>) -> (!fir.ref) -> !fir.box>>>>, !fir.ref) -> !fir.box>>>>) - - call foo1(pp1) -! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref) -> f32>> -! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<(!fir.ref) -> f32>) -> !fir.boxproc<() -> ()> -! CHECK: fir.call @_QPfoo1(%[[VAL_5]]) fastmath : (!fir.boxproc<() -> ()>) -> () - - call foo2(pp2) -! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref) -> !fir.box>>>>) -> !fir.ref ()>> -! CHECK: fir.call @_QPfoo2(%[[VAL_6]]) fastmath : (!fir.ref ()>>) -> () -end - -subroutine sub9() -use m - procedure(real_func), pointer :: p1 -! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> f32> {bindc_name = "p1", uniq_name = "_QFsub9Ep1"} -! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref) -> f32 -! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref) -> f32>> -! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub9Ep1"} : (!fir.ref) -> f32>>) -> (!fir.ref) -> f32>>, !fir.ref) -> f32>>) - - procedure(char_func), pointer :: p2 -! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.boxproc<(!fir.ref) -> !fir.box>>> {bindc_name = "p2", uniq_name = "_QFsub9Ep2"} -! CHECK: %[[VAL_5:.*]] = fir.zero_bits (!fir.ref) -> !fir.box>> -! CHECK: %[[VAL_6:.*]] = fir.emboxproc %[[VAL_5]] : ((!fir.ref) -> !fir.box>>) -> !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: fir.store %[[VAL_6]] to %[[VAL_4]] : !fir.ref) -> !fir.box>>>> -! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub9Ep2"} : (!fir.ref) -> !fir.box>>>>) -> (!fir.ref) -> !fir.box>>>>, !fir.ref) -> !fir.box>>>>) - - call foo1(p1) -! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref) -> f32>> -! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.boxproc<(!fir.ref) -> f32>) -> !fir.boxproc<() -> ()> -! CHECK: fir.call @_QPfoo1(%[[VAL_9]]) fastmath : (!fir.boxproc<() -> ()>) -> () - - call foo2(p2) -! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref) -> !fir.box>>>>) -> !fir.ref ()>> -! CHECK: fir.call @_QPfoo2(%[[VAL_10]]) fastmath : (!fir.ref ()>>) -> () -end - - -! CHECK-LABEL: fir.global internal @_QFsub1Ep2 : !fir.boxproc<(!fir.ref) -> f32> { -! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref) -> f32 -! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref) -> f32> -! CHECK: } - -! CHECK-LABEL: fir.global internal @_QFsub1Ep3 : !fir.boxproc<(!fir.ref) -> f32> { -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QPreal_func) : (!fir.ref) -> f32 -! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref) -> f32) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.has_value %[[VAL_2]] : !fir.boxproc<(!fir.ref) -> f32> -! CHECK: } - -! CHECK-LABEL: fir.global internal @_QFsub1Ep7 : !fir.boxproc<(!fir.ref) -> !fir.box>>> { -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QPchar_func) : (!fir.ref) -> !fir.box>> -! CHECK: %[[VAL_11:.*]] = arith.constant -1 : index -! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref) -> !fir.box>>) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_11]] : (index) -> i64 -! CHECK: %[[VAL_3:.*]] = fir.undefined tuple ()>, i64> -! CHECK: %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_1]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> -! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> -! CHECK: %[[VAL_6:.*]] = fir.extract_value %[[VAL_5]], [0 : index] : (tuple ()>, i64>) -> !fir.boxproc<() -> ()> -! CHECK: %[[VAL_7:.*]] = fir.extract_value %[[VAL_5]], [1 : index] : (tuple ()>, i64>) -> i64 -! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: fir.has_value %[[VAL_8]] : !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: } - -! CHECK-LABEL: fir.global internal @_QFsub8Epp1 : !fir.boxproc<(!fir.ref) -> f32> { -! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref) -> f32 -! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref) -> f32) -> !fir.boxproc<(!fir.ref) -> f32> -! CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref) -> f32> -! CHECK: } - -! CHECK-LABEL: fir.global internal @_QFsub8Epp2 : !fir.boxproc<(!fir.ref) -> !fir.box>>> { -! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref) -> !fir.box>> -! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref) -> !fir.box>>) -> !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref) -> !fir.box>>> -! CHECK: }