[flang-commits] [flang] 49f55d1 - Revert "[Flang] Add partial support for lowering procedure pointer assignment. (#70461)"
Muhammad Omair Javaid via flang-commits
flang-commits at lists.llvm.org
Wed Nov 22 23:31:42 PST 2023
Author: Muhammad Omair Javaid
Date: 2023-11-23T12:30:40+05:00
New Revision: 49f55d107548a340992eaec1b9767c0f8fc443cd
URL: https://github.com/llvm/llvm-project/commit/49f55d107548a340992eaec1b9767c0f8fc443cd
DIFF: https://github.com/llvm/llvm-project/commit/49f55d107548a340992eaec1b9767c0f8fc443cd.diff
LOG: Revert "[Flang] Add partial support for lowering procedure pointer assignment. (#70461)"
This reverts commit e07fec10ac208c2868a24c5c0be88e45778b297e.
This change appears to have broken following buildbots:
https://lab.llvm.org/buildbot/#/builders/176
https://lab.llvm.org/buildbot/#/builders/179
https://lab.llvm.org/buildbot/#/builders/184
https://lab.llvm.org/buildbot/#/builders/197
https://lab.llvm.org/buildbot/#/builders/198
All bots fails in testsuite where following tests seems broken:
(eg: https://lab.llvm.org/buildbot/#/builders/176/builds/7131)
test-suite::gfortran-regression-compile-regression__proc_ptr_46_f90.test
test-suite::gfortran-regression-compile-regression__proc_ptr_37_f90.test
Added:
Modified:
flang/include/flang/Lower/BoxAnalyzer.h
flang/include/flang/Lower/CallInterface.h
flang/include/flang/Lower/ConvertProcedureDesignator.h
flang/include/flang/Optimizer/Builder/FIRBuilder.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/lib/Lower/ConvertProcedureDesignator.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Optimizer/Builder/FIRBuilder.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
Removed:
flang/test/Lower/HLFIR/procedure-pointer.f90
################################################################################
diff --git a/flang/include/flang/Lower/BoxAnalyzer.h b/flang/include/flang/Lower/BoxAnalyzer.h
index 3b8e2455ff273be..52cded8b219d835 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<BoxAnalyzer> {
/// 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<int64_t> lbounds;
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index c7dca4f8f1348e0..579bdcfd8988792 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 <procedure address, result length>
// 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<T>::FortranEntity;
diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
index ae772c52e425bc1..86a757a9aadf4f4 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 b5b2c99810b15bb..0b36186d68a4614 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 999ac9c7a42fad2..07bb380320bf712 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 e8f28485298277d..aa68d0811c4868a 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<fir::BaseBoxType>();
}
-/// Is this a fir.boxproc address type?
-inline bool isBoxProcAddressType(mlir::Type type) {
- type = fir::dyn_cast_ptrEleTy(type);
- return type && type.isa<fir::BoxProcType>();
-}
-
/// Is this a fir.box or fir.class address or value type?
inline bool isBoxAddressOrValueType(mlir::Type type) {
return fir::unwrapRefType(type).isa<fir::BaseBoxType>();
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 23c48cc7bd97874..872bf6bc729ecd0 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<Fortran::evaluate::DynamicType> lhsType =
assign.lhs.GetType();
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index b1420dcb25a1145..51b0579fac36c0f 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -23,10 +23,6 @@
#include "flang/Semantics/tools.h"
#include <optional>
-static mlir::FunctionType
-getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc,
- Fortran::lower::AbstractConverter &converter);
-
mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
llvm::SmallVector<mlir::Type> resultTys;
llvm::SmallVector<mlir::Type> 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<Fortran::evaluate::DynamicType> 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::ReferenceType>() &&
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 395a98b43d53793..82e1ece4efeafe7 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<fir::LoadOp>(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<fir::StoreOp>(loc, nullBoxProc, tempBoxProc);
- return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
- }
-
+ // Do nothing if this is a procedure argument. It is already a
+ // fir.boxproc/fir.tuple<fir.boxproc, len> 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<fir::StoreOp>(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<fir.boxproc, len> 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<Fortran::evaluate::NullPointer>(
*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 da2b32ac8226855..8c2318632f725b1 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 b114fbe1a13a26b..5a51493c9aaa5d4 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 <typename T>
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 84e04b0a65f447e..20ade1a04049fc4 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<fir::FortranVariableOpInterface> 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 72f1ee7a2cb2baa..1ed3b602621b449 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 d4f738e5dae116f..e8137886d2cf54b 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<Fortran::semantics::ObjectEntityDetails>();
if (details && details->init()) {
@@ -530,6 +527,7 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
b.create<fir::HasValueOp>(loc, box);
});
}
+
} else if (const auto *details =
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
if (details->init()) {
@@ -554,39 +552,10 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
builder.create<fir::HasValueOp>(loc, castTo);
});
}
- } else if (Fortran::semantics::IsProcedurePointer(sym)) {
- const auto *details{sym.detailsIf<Fortran::semantics::ProcEntityDetails>()};
- 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<fir::HasValueOp>(loc, castTo);
- });
- else { // Has NULL() target.
- Fortran::lower::createGlobalInitialization(
- builder, global, [&](fir::FirOpBuilder &b) {
- auto box{fir::factory::createNullBoxProc(b, loc, symTy)};
- b.create<fir::HasValueOp>(loc, box);
- });
- }
- } else {
- // No initialization.
- Fortran::lower::createGlobalInitialization(
- builder, global, [&](fir::FirOpBuilder &b) {
- auto box{fir::factory::createNullBoxProc(b, loc, symTy)};
- b.create<fir::HasValueOp>(loc, box);
- });
- }
} else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
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<fir::StoreOp>(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<Fortran::semantics::CommonBlockDetails>()) {
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 df42dc8a3d0c8ba..c6d632036c82e96 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<fir::LoadOp>(loc, cPtrAddr);
}
-
-mlir::Value fir::factory::createNullBoxProc(fir::FirOpBuilder &builder,
- mlir::Location loc,
- mlir::Type boxType) {
- auto boxTy{boxType.dyn_cast<fir::BoxProcType>()};
- if (!boxTy)
- fir::emitFatalError(loc, "Procedure pointer must be of BoxProcType");
- auto boxEleTy{fir::unwrapRefType(boxTy.getEleTy())};
- mlir::Value initVal{builder.create<fir::ZeroOp>(loc, boxEleTy)};
- return builder.create<fir::EmboxProcOp>(loc, boxTy, initVal);
-}
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 88d3f15deb9b3b8..3d0a59b468ba791 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<fir::LoadOp>(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 12bb7c67cd2d40a..000000000000000
--- 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>) -> f32> {bindc_name = "p1", uniq_name = "_QFsub1Ep1"}
-! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep1"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
-
- procedure(real_func), pointer :: p2 => null()
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub1Ep2) : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep2"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
-
- procedure(real_func), pointer :: p3 => real_func
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub1Ep3) : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep3"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> 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<!fir.boxproc<() -> ()>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep4"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
-
- 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<!fir.boxproc<() -> f32>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep5"} : (!fir.ref<!fir.boxproc<() -> f32>>) -> (!fir.ref<!fir.boxproc<() -> f32>>, !fir.ref<!fir.boxproc<() -> f32>>)
-
- procedure(char_func), pointer :: p6
-! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>> {bindc_name = "p6", uniq_name = "_QFsub1Ep6"}
-! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep6"} : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>, !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>)
-
- procedure(char_func), pointer :: p7 => char_func
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub1Ep7) : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub1Ep7"} : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>, !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>)
-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>) -> f32> {bindc_name = "p1", uniq_name = "_QFsub2Ep1"}
-! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub2Ep1"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> 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>) -> f32>
-! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> 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>) -> f32> {bindc_name = "p1", uniq_name = "_QFsub3Ep1"}
-! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub3Ep1"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
-! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPreal_func) : (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-
- res = p1(r)
-! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.boxproc<(!fir.ref<f32>) -> f32>) -> ((!fir.ref<f32>) -> f32)
-! CHECK: %[[VAL_9:.*]] = fir.call %[[VAL_8]](%5#1) fastmath<contract> : (!fir.ref<f32>) -> 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>) -> f32>
-! CHECK: fir.store %[[VAL_12]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> 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<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>> {bindc_name = "p2", uniq_name = "_QFsub4Ep2"}
-! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub4Ep2"} : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>, !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>)
-! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPchar_func) : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-! CHECK: %[[VAL_12:.*]] = arith.constant -1 : index
-! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_12]] : (index) -> i64
-! CHECK: %[[VAL_7:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK: %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_5]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_6]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK: %[[VAL_10:.*]] = fir.extract_value %[[VAL_9]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: fir.store %[[VAL_11]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-
- res = p2(i)
-! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_12]] : (!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>) -> ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>)
-! CHECK: %[[VAL_14:.*]] = fir.call %[[VAL_13]](%2#1) fastmath<contract> : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-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<!fir.boxproc<() -> f32>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub5Ep3"} : (!fir.ref<!fir.boxproc<() -> f32>>) -> (!fir.ref<!fir.boxproc<() -> f32>>, !fir.ref<!fir.boxproc<() -> f32>>)
-! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPreal_func) : (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref<f32>) -> 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<!fir.boxproc<() -> 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<!fir.boxproc<() -> ()>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %0 {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub6Ep4"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
-! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QPsub) : (!fir.ref<f32>) -> ()
-! CHECK: %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref<f32>) -> ()) -> !fir.boxproc<() -> ()>
-! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
-
- call p4(r)
-! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
-! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<f32>) -> ())
-! CHECK: fir.call %[[VAL_7]](%5#1) fastmath<contract> : (!fir.ref<f32>) -> ()
-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<pointer>, uniq_name = "_QFsub7Ep1"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
-
- procedure(char_func), pointer :: p2
-! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %arg1 {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub7Ep2"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
-
- call foo1(p1)
-! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
-! CHECK: fir.call @_QPfoo1(%[[VAL_2]]) fastmath<contract> : (!fir.boxproc<() -> ()>) -> ()
-
- call foo2(p2)
-! CHECK: fir.call @_QPfoo2(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
-end
-
-subroutine sub8()
-use m
- procedure(real_func), pointer, save :: pp1
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFsub8Epp1) : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub8Epp1"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
-
- procedure(char_func), pointer, save :: pp2
-! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFsub8Epp2) : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub8Epp2"} : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>, !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>)
-
- call foo1(pp1)
-! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<(!fir.ref<f32>) -> f32>) -> !fir.boxproc<() -> ()>
-! CHECK: fir.call @_QPfoo1(%[[VAL_5]]) fastmath<contract> : (!fir.boxproc<() -> ()>) -> ()
-
- call foo2(pp2)
-! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> !fir.ref<!fir.boxproc<() -> ()>>
-! CHECK: fir.call @_QPfoo2(%[[VAL_6]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
-end
-
-subroutine sub9()
-use m
- procedure(real_func), pointer :: p1
-! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref<f32>) -> f32> {bindc_name = "p1", uniq_name = "_QFsub9Ep1"}
-! CHECK: %[[VAL_1:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub9Ep1"} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
-
- procedure(char_func), pointer :: p2
-! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>> {bindc_name = "p2", uniq_name = "_QFsub9Ep2"}
-! CHECK: %[[VAL_5:.*]] = fir.zero_bits (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-! CHECK: %[[VAL_6:.*]] = fir.emboxproc %[[VAL_5]] : ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: fir.store %[[VAL_6]] to %[[VAL_4]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>
-! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub9Ep2"} : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>, !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>)
-
- call foo1(p1)
-! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
-! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.boxproc<(!fir.ref<f32>) -> f32>) -> !fir.boxproc<() -> ()>
-! CHECK: fir.call @_QPfoo1(%[[VAL_9]]) fastmath<contract> : (!fir.boxproc<() -> ()>) -> ()
-
- call foo2(p2)
-! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>>) -> !fir.ref<!fir.boxproc<() -> ()>>
-! CHECK: fir.call @_QPfoo2(%[[VAL_10]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
-end
-
-
-! CHECK-LABEL: fir.global internal @_QFsub1Ep2 : !fir.boxproc<(!fir.ref<f32>) -> f32> {
-! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: }
-
-! CHECK-LABEL: fir.global internal @_QFsub1Ep3 : !fir.boxproc<(!fir.ref<f32>) -> f32> {
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QPreal_func) : (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.has_value %[[VAL_2]] : !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: }
-
-! CHECK-LABEL: fir.global internal @_QFsub1Ep7 : !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>> {
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QPchar_func) : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-! CHECK: %[[VAL_11:.*]] = arith.constant -1 : index
-! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_11]] : (index) -> i64
-! CHECK: %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK: %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_1]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
-! CHECK: %[[VAL_6:.*]] = fir.extract_value %[[VAL_5]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_7:.*]] = fir.extract_value %[[VAL_5]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
-! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: fir.has_value %[[VAL_8]] : !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: }
-
-! CHECK-LABEL: fir.global internal @_QFsub8Epp1 : !fir.boxproc<(!fir.ref<f32>) -> f32> {
-! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
-! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref<f32>) -> f32>
-! CHECK: }
-
-! CHECK-LABEL: fir.global internal @_QFsub8Epp2 : !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>> {
-! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
-! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.char<1,?>>>>
-! CHECK: }
More information about the flang-commits
mailing list