[llvm] [clang] [clang-tools-extra] [flang] [flang] Lower procedure pointer components (PR #75453)
via cfe-commits
cfe-commits at lists.llvm.org
Tue Dec 19 07:41:25 PST 2023
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/75453
>From e4618a1470b49abd35d177ef16cd6413a75aaf09 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 14 Dec 2023 01:25:00 -0800
Subject: [PATCH 1/5] [flang] Lower procedure pointer components
Lower procedure pointer components, except in the context of
structure constructor (left TODO).
Procedure pointer components lowering share most of the lowering
logic of procedure poionters with the following particularities:
- They are components, so an hlfir.designate must be generated to
retrieve the procedure pointer address from its derived type base.
- They may have a PASS argument. While there is no dispatching as with
type bound procedure, special care must be taken to retrieve the
derived type component base in this case since semantics placed it
in the argument list and not in the evaluate::ProcedureDesignator.
These components also bring a new level of recursive MLIR types since a
fir.type may now contain a component with an MLIR function type where
one of the argument is the fir.type itself. This required moving the
"derived type in construction" stackto the converter so that the object
and function type lowering utilities share the same state (currently the
function type utilty would end-up creating a new stack when lowering its
arguments, leading to infinite loops). The BoxedProcedurePass also
needed an update to deal with this recursive aspect.
---
flang/include/flang/Lower/AbstractConverter.h | 6 +
flang/include/flang/Lower/CallInterface.h | 4 +-
.../flang/Lower/ConvertProcedureDesignator.h | 8 ++
.../flang/Optimizer/Support/InternalNames.h | 8 ++
flang/lib/Lower/Bridge.cpp | 52 +++++---
flang/lib/Lower/CallInterface.cpp | 11 +-
flang/lib/Lower/ConvertCall.cpp | 38 ++++--
flang/lib/Lower/ConvertConstant.cpp | 2 +
flang/lib/Lower/ConvertExpr.cpp | 2 +-
flang/lib/Lower/ConvertExprToHLFIR.cpp | 2 +
.../lib/Lower/ConvertProcedureDesignator.cpp | 57 ++++++++
flang/lib/Lower/ConvertType.cpp | 8 +-
.../lib/Optimizer/CodeGen/BoxedProcedure.cpp | 18 ++-
flang/lib/Optimizer/CodeGen/TypeConverter.cpp | 3 +-
flang/lib/Optimizer/Support/InternalNames.cpp | 11 +-
.../Lower/HLFIR/proc-pointer-comp-nopass.f90 | 123 ++++++++++++++++++
.../Lower/HLFIR/proc-pointer-comp-pass.f90 | 81 ++++++++++++
.../Lower/HLFIR/procedure-designators.f90 | 8 +-
flang/test/Lower/HLFIR/procedure-pointer.f90 | 6 +-
19 files changed, 390 insertions(+), 58 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/proc-pointer-comp-nopass.f90
create mode 100644 flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90
diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h
index 980fde88137324..710dfac21639c5 100644
--- a/flang/include/flang/Lower/AbstractConverter.h
+++ b/flang/include/flang/Lower/AbstractConverter.h
@@ -58,6 +58,8 @@ struct Variable;
using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
using SymbolRef = Fortran::common::Reference<const Fortran::semantics::Symbol>;
+using TypeConstructionStack =
+ llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>>;
class StatementContext;
using ExprToValueMap = llvm::DenseMap<const SomeExpr *, mlir::Value>;
@@ -231,6 +233,10 @@ class AbstractConverter {
const Fortran::semantics::DerivedTypeSpec &typeSpec,
fir::RecordType type) = 0;
+ /// Get stack of derived type in construction. This is an internal entry point
+ /// for the type conversion utility to allow lowering recursive derived types.
+ virtual TypeConstructionStack &getTypeConstructionStack() = 0;
+
//===--------------------------------------------------------------------===//
// Locations
//===--------------------------------------------------------------------===//
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index c7dca4f8f1348e..420261b3dda552 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -314,8 +314,8 @@ class CallerInterface : public CallInterface<CallerInterface> {
mlir::Value addr, mlir::Value len);
/// If this is a call to a procedure pointer or dummy, returns the related
- /// symbol. Nullptr otherwise.
- const Fortran::semantics::Symbol *getIfIndirectCallSymbol() const;
+ /// procedure designator. Nullptr otherwise.
+ const Fortran::evaluate::ProcedureDesignator *getIfIndirectCall() const;
/// Get the input vector once it is complete.
llvm::ArrayRef<mlir::Value> getInputs() const {
diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
index ae772c52e425bc..b3e0dc3fa53acc 100644
--- a/flang/include/flang/Lower/ConvertProcedureDesignator.h
+++ b/flang/include/flang/Lower/ConvertProcedureDesignator.h
@@ -60,5 +60,13 @@ mlir::Value
convertProcedureDesignatorInitialTarget(Fortran::lower::AbstractConverter &,
mlir::Location,
const Fortran::semantics::Symbol &sym);
+
+/// Given the value of a "PASS" actual argument \p passedArg and the
+/// evaluate::ProcedureDesignator for the call, address and dereference
+/// the argument's procedure pointer component that must be called.
+mlir::Value derefPassProcPointerComponent(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::ProcedureDesignator &proc, mlir::Value passedArg,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H
diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h
index f3f9fe70518935..23a03854c4abd0 100644
--- a/flang/include/flang/Optimizer/Support/InternalNames.h
+++ b/flang/include/flang/Optimizer/Support/InternalNames.h
@@ -156,6 +156,14 @@ struct NameUniquer {
static std::string
getTypeDescriptorBindingTableName(llvm::StringRef mangledTypeName);
+ /// Remove markers that have been added when doing partial type
+ /// conversions. mlir::Type cannot be mutated in a pass, so new
+ /// fir::RecordType must be created when lowering member types.
+ /// Suffixes added to these new types are meaningless and are
+ /// dropped in the names passed to LLVM.
+ static llvm::StringRef
+ dropTypeConversionMarkers(llvm::StringRef mangledTypeName);
+
private:
static std::string intAsString(std::int64_t i);
static std::string doKind(std::int64_t kind);
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 7e64adc3c144c9..681d9562b5721c 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -170,25 +170,22 @@ class TypeInfoConverter {
if (seen.contains(typeInfoSym))
return;
seen.insert(typeInfoSym);
- if (!skipRegistration) {
- registeredTypeInfo.emplace_back(
- TypeInfo{typeInfoSym, typeSpec, type, loc});
- return;
- }
- // Once the registration is closed, symbols cannot be added to the
- // registeredTypeInfoSymbols list because it may be iterated over.
- // However, after registration is closed, it is safe to directly generate
- // the globals because all FuncOps whose addresses may be required by the
- // initializers have been generated.
- createTypeInfoOpAndGlobal(converter,
- TypeInfo{typeInfoSym, typeSpec, type, loc});
+ currentTypeInfoStack->emplace_back(
+ TypeInfo{typeInfoSym, typeSpec, type, loc});
+ return;
}
void createTypeInfo(Fortran::lower::AbstractConverter &converter) {
- skipRegistration = true;
- for (const TypeInfo &info : registeredTypeInfo)
- createTypeInfoOpAndGlobal(converter, info);
- registeredTypeInfo.clear();
+ while (!registeredTypeInfoA.empty()) {
+ currentTypeInfoStack = ®isteredTypeInfoB;
+ for (const TypeInfo &info : registeredTypeInfoA)
+ createTypeInfoOpAndGlobal(converter, info);
+ registeredTypeInfoA.clear();
+ currentTypeInfoStack = ®isteredTypeInfoA;
+ for (const TypeInfo &info : registeredTypeInfoB)
+ createTypeInfoOpAndGlobal(converter, info);
+ registeredTypeInfoB.clear();
+ }
}
private:
@@ -249,11 +246,12 @@ class TypeInfoConverter {
}
/// Store the front-end data that will be required to generate the type info
- /// for the derived types that have been converted to fir.type<>.
- llvm::SmallVector<TypeInfo> registeredTypeInfo;
- /// Create derived type info immediately without storing the
- /// symbol in registeredTypeInfo.
- bool skipRegistration = false;
+ /// for the derived types that have been converted to fir.type<>. There are
+ /// two stacks since the type info may visit new types, so the new types must
+ /// be added to a new stack.
+ llvm::SmallVector<TypeInfo> registeredTypeInfoA;
+ llvm::SmallVector<TypeInfo> registeredTypeInfoB;
+ llvm::SmallVector<TypeInfo> *currentTypeInfoStack = ®isteredTypeInfoA;
/// Track symbols symbols processed during and after the registration
/// to avoid infinite loops between type conversions and global variable
/// creation.
@@ -602,6 +600,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
std::nullopt);
}
+ Fortran::lower::TypeConstructionStack &
+ getTypeConstructionStack() override final {
+ return typeConstructionStack;
+ }
+
bool isPresentShallowLookup(Fortran::semantics::Symbol &sym) override final {
return bool(shallowLookupSymbol(sym));
}
@@ -5052,6 +5055,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
bool ompDeviceCodeFound = false;
const Fortran::lower::ExprToValueMap *exprValueOverrides{nullptr};
+
+ /// Stack of derived type under construction to avoid infinite loops when
+ /// dealing with recursive derived types. This is held in the bridge because
+ /// the state needs to be maintained between data and function type lowering
+ /// utilities to deal with procedure pointer components whose arguments have
+ /// the type of the containing derived type.
+ Fortran::lower::TypeConstructionStack typeConstructionStack;
};
} // namespace
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 1f41c3bec847ec..376718edb1ab5a 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -87,6 +87,11 @@ bool Fortran::lower::CallerInterface::isIndirectCall() const {
}
bool Fortran::lower::CallerInterface::requireDispatchCall() const {
+ // Procedure pointer component reference do not require dispatch, but
+ // have PASS/NOPASS argument.
+ if (const Fortran::semantics::Symbol *sym = procRef.proc().GetSymbol())
+ if (Fortran::semantics::IsPointer(*sym))
+ return false;
// calls with NOPASS attribute still have their component so check if it is
// polymorphic.
if (const Fortran::evaluate::Component *component =
@@ -127,12 +132,12 @@ Fortran::lower::CallerInterface::getPassArgIndex() const {
return passArg;
}
-const Fortran::semantics::Symbol *
-Fortran::lower::CallerInterface::getIfIndirectCallSymbol() const {
+const Fortran::evaluate::ProcedureDesignator *
+Fortran::lower::CallerInterface::getIfIndirectCall() const {
if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
if (Fortran::semantics::IsPointer(*symbol) ||
Fortran::semantics::IsDummy(*symbol))
- return symbol;
+ return &procRef.proc();
return nullptr;
}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 49e70181a668c6..a49dd98a34eb26 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -13,6 +13,7 @@
#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/ConvertExprToHLFIR.h"
+#include "flang/Lower/ConvertProcedureDesignator.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/CustomIntrinsicCall.h"
#include "flang/Lower/HlfirIntrinsics.h"
@@ -165,20 +166,29 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
// will be used only if there is no explicit length in the local interface).
mlir::Value funcPointer;
mlir::Value charFuncPointerLength;
- if (const Fortran::semantics::Symbol *sym =
- caller.getIfIndirectCallSymbol()) {
- funcPointer = fir::getBase(converter.getSymbolExtendedValue(*sym, &symMap));
- if (!funcPointer)
- fir::emitFatalError(loc, "failed to find indirect call symbol address");
- if (fir::isCharacterProcedureTuple(funcPointer.getType(),
- /*acceptRawFunc=*/false))
- 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);
+ if (const Fortran::evaluate::ProcedureDesignator *procDesignator =
+ caller.getIfIndirectCall()) {
+ if (std::optional<unsigned> passArg = caller.getPassArgIndex()) {
+ // Procedure pointer component call with PASS argument. To avoid
+ // "double" lowering of the ComponentRef, semantics only place the
+ // ComponentRef in the ActualArguments, not in the ProcedureDesignator (
+ // that is only the component symbol).
+ // Fetch the passed argument and addresses of its procedure pointer
+ // component.
+ mlir::Value passedArg = caller.getInputs()[*passArg];
+ funcPointer = Fortran::lower::derefPassProcPointerComponent(
+ loc, converter, *procDesignator, passedArg, symMap, stmtCtx);
+ } else {
+ Fortran::lower::SomeExpr expr{*procDesignator};
+ fir::ExtendedValue loweredProc =
+ converter.genExprAddr(loc, expr, stmtCtx);
+ funcPointer = fir::getBase(loweredProc);
+ // Dummy procedure may have assumed length, in which case the result
+ // length was passed along the dummy procedure.
+ // This is not possible with procedure pointer components.
+ if (const fir::CharBoxValue *charBox = loweredProc.getCharBox())
+ charFuncPointerLength = charBox->getLen();
+ }
}
mlir::IndexType idxTy = builder.getIndexType();
diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index 56ca7ab2d93103..d7a4d68f2aaae7 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -366,6 +366,8 @@ static mlir::Value genStructureComponentInit(
TODO(loc, "allocatable component in structure constructor");
if (Fortran::semantics::IsPointer(sym)) {
+ if (Fortran::semantics::IsProcedure(sym))
+ TODO(loc, "procedure pointer component initial value");
mlir::Value initialTarget =
Fortran::lower::genInitialDataTarget(converter, loc, componentTy, expr);
res = builder.create<fir::InsertValueOp>(
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 34e77581fca338..a2b28aa2e04912 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -4849,7 +4849,7 @@ class ArrayExprLowering {
}
}
- if (caller.getIfIndirectCallSymbol())
+ if (caller.getIfIndirectCall())
fir::emitFatalError(loc, "cannot be indirect call");
// The lambda is mutable so that `caller` copy can be modified inside it.
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 7771b4a635f293..a3ad10978e5986 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1738,6 +1738,8 @@ class HlfirBuilder {
if (attrs && bitEnumContainsAny(attrs.getFlags(),
fir::FortranVariableFlagsEnum::pointer)) {
+ if (Fortran::semantics::IsProcedure(sym))
+ TODO(loc, "procedure pointer component in structure constructor");
// Pointer component construction is just a copy of the box contents.
fir::ExtendedValue lhsExv =
hlfir::translateToExtendedValue(loc, builder, lhs);
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 84e04b0a65f447..a4c09386a01c76 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -19,6 +19,7 @@
#include "flang/Optimizer/Builder/IntrinsicCall.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,
Fortran::lower::SymMap &symMap) {
@@ -96,6 +97,46 @@ fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
return funcPtr;
}
+static hlfir::EntityWithAttributes designateProcedurePointerComponent(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::Symbol &procComponentSym, mlir::Value base,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ fir::FortranVariableFlagsAttr attributes =
+ Fortran::lower::translateSymbolAttributes(builder.getContext(),
+ procComponentSym);
+ /// Passed argument may be a descriptor. This is a scalar reference, so the
+ /// base address can be directly addressed.
+ if (base.getType().isa<fir::BaseBoxType>())
+ base = builder.create<fir::BoxAddrOp>(loc, base);
+ std::string fieldName = converter.getRecordTypeFieldName(procComponentSym);
+ auto recordType =
+ hlfir::getFortranElementType(base.getType()).cast<fir::RecordType>();
+ mlir::Type fieldType = recordType.getType(fieldName);
+ assert(fieldType && "procedure component name is not known");
+ mlir::Type designatorType = fir::ReferenceType::get(fieldType);
+ mlir::Value compRef = builder.create<hlfir::DesignateOp>(
+ loc, designatorType, base, fieldName,
+ /*compShape=*/mlir::Value{}, hlfir::DesignateOp::Subscripts{},
+ /*substring=*/mlir::ValueRange{},
+ /*complexPart=*/std::nullopt,
+ /*shape=*/mlir::Value{}, /*typeParams=*/mlir::ValueRange{}, attributes);
+ return hlfir::EntityWithAttributes{compRef};
+}
+
+static hlfir::EntityWithAttributes convertProcedurePointerComponent(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::Component &procComponent,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+ fir::ExtendedValue baseExv = Fortran::lower::convertDataRefToValue(
+ loc, converter, procComponent.base(), symMap, stmtCtx);
+ mlir::Value base = fir::getBase(baseExv);
+ const Fortran::semantics::Symbol &procComponentSym =
+ procComponent.GetLastSymbol();
+ return designateProcedurePointerComponent(loc, converter, procComponentSym,
+ base, symMap, stmtCtx);
+}
+
hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
const Fortran::evaluate::ProcedureDesignator &proc,
@@ -109,6 +150,10 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
return *varDef;
}
+ if (const Fortran::evaluate::Component *procComponent = proc.GetComponent())
+ return convertProcedurePointerComponent(loc, converter, *procComponent,
+ symMap, stmtCtx);
+
fir::ExtendedValue procExv =
convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
// Directly package the procedure address as a fir.boxproc or
@@ -148,3 +193,15 @@ mlir::Value Fortran::lower::convertProcedureDesignatorInitialTarget(
return fir::getBase(Fortran::lower::convertToAddress(
loc, converter, procVal, stmtCtx, procVal.getType()));
}
+
+mlir::Value Fortran::lower::derefPassProcPointerComponent(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::ProcedureDesignator &proc, mlir::Value passedArg,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+ const Fortran::semantics::Symbol *procComponentSym = proc.GetSymbol();
+ assert(procComponentSym &&
+ "failed to retrieve pointer procedure component symbol");
+ hlfir::EntityWithAttributes pointerComp = designateProcedurePointerComponent(
+ loc, converter, *procComponentSym, passedArg, symMap, stmtCtx);
+ return converter.getFirOpBuilder().create<fir::LoadOp>(loc, pointerComp);
+}
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 72f1ee7a2cb2ba..8caafb72e472a5 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -140,7 +140,8 @@ namespace {
struct TypeBuilderImpl {
TypeBuilderImpl(Fortran::lower::AbstractConverter &converter)
- : converter{converter}, context{&converter.getMLIRContext()} {}
+ : derivedTypeInConstruction{converter.getTypeConstructionStack()},
+ converter{converter}, context{&converter.getMLIRContext()} {}
template <typename A>
mlir::Type genExprType(const A &expr) {
@@ -398,8 +399,6 @@ struct TypeBuilderImpl {
assert(scopeIter != derivedScope.cend() &&
"failed to find derived type component symbol");
const Fortran::semantics::Symbol &component = scopeIter->second.get();
- if (IsProcedure(component))
- TODO(converter.genLocation(component.name()), "procedure components");
mlir::Type ty = genSymbolType(component);
cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
}
@@ -568,8 +567,7 @@ struct TypeBuilderImpl {
/// Stack derived type being processed to avoid infinite loops in case of
/// recursive derived types. The depth of derived types is expected to be
/// shallow (<10), so a SmallVector is sufficient.
- llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>>
- derivedTypeInConstruction;
+ Fortran::lower::TypeConstructionStack &derivedTypeInConstruction;
Fortran::lower::AbstractConverter &converter;
mlir::MLIRContext *context;
};
diff --git a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
index 524f0e3135ac30..49df6efdee2d31 100644
--- a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
+++ b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
@@ -19,6 +19,7 @@
#include "mlir/IR/PatternMatch.h"
#include "mlir/Pass/Pass.h"
#include "mlir/Transforms/DialectConversion.h"
+#include "llvm/ADT/MapVector.h"
namespace fir {
#define GEN_PASS_DEF_BOXEDPROCEDUREPASS
@@ -81,7 +82,7 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
visitedTypes.pop_back();
return result;
}
- if (auto boxTy = ty.dyn_cast<BoxType>())
+ if (auto boxTy = ty.dyn_cast<BaseBoxType>())
return needsConversion(boxTy.getEleTy());
if (isa_ref_type(ty))
return needsConversion(unwrapRefType(ty));
@@ -119,6 +120,9 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
[&](HeapType ty) { return HeapType::get(convertType(ty.getEleTy())); });
addConversion(
[&](BoxType ty) { return BoxType::get(convertType(ty.getEleTy())); });
+ addConversion([&](ClassType ty) {
+ return ClassType::get(convertType(ty.getEleTy()));
+ });
addConversion([&](SequenceType ty) {
// TODO: add ty.getLayoutMap() as needed.
return SequenceType::get(ty.getShape(), convertType(ty.getEleTy()));
@@ -126,10 +130,13 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
addConversion([&](RecordType ty) -> mlir::Type {
if (!needsConversion(ty))
return ty;
+ if (auto converted = typeInConversion.lookup(ty))
+ return converted;
auto rec = RecordType::get(ty.getContext(),
ty.getName().str() + boxprocSuffix.str());
if (rec.isFinalized())
return rec;
+ auto it = typeInConversion.try_emplace(ty, rec);
std::vector<RecordType::TypePair> ps = ty.getLenParamList();
std::vector<RecordType::TypePair> cs;
for (auto t : ty.getTypeList()) {
@@ -139,6 +146,7 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
cs.emplace_back(t.first, t.second);
}
rec.finalize(ps, cs);
+ typeInConversion.erase(it.first);
return rec;
});
addArgumentMaterialization(materializeProcedure);
@@ -159,6 +167,7 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
private:
llvm::SmallVector<mlir::Type> visitedTypes;
+ llvm::SmallMapVector<mlir::Type, mlir::Type, 8> typeInConversion;
mlir::Location loc;
};
@@ -193,7 +202,8 @@ class BoxedProcedurePass
getModule().walk([&](mlir::Operation *op) {
typeConverter.setLocation(op->getLoc());
if (auto addr = mlir::dyn_cast<BoxAddrOp>(op)) {
- auto ty = addr.getVal().getType();
+ mlir::Type ty = addr.getVal().getType();
+ mlir::Type resTy = addr.getResult().getType();
if (typeConverter.needsConversion(ty) ||
ty.isa<mlir::FunctionType>()) {
// Rewrite all `fir.box_addr` ops on values of type `!fir.boxproc`
@@ -201,6 +211,10 @@ class BoxedProcedurePass
rewriter.setInsertionPoint(addr);
rewriter.replaceOpWithNewOp<ConvertOp>(
addr, typeConverter.convertType(addr.getType()), addr.getVal());
+ } else if (typeConverter.needsConversion(resTy)) {
+ rewriter.startRootUpdate(op);
+ op->getResult(0).setType(typeConverter.convertType(resTy));
+ rewriter.finalizeRootUpdate(op);
}
} else if (auto func = mlir::dyn_cast<mlir::func::FuncOp>(op)) {
mlir::FunctionType ty = func.getFunctionType();
diff --git a/flang/lib/Optimizer/CodeGen/TypeConverter.cpp b/flang/lib/Optimizer/CodeGen/TypeConverter.cpp
index 209c586411f410..62a8e4750dc8c9 100644
--- a/flang/lib/Optimizer/CodeGen/TypeConverter.cpp
+++ b/flang/lib/Optimizer/CodeGen/TypeConverter.cpp
@@ -20,6 +20,7 @@
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/Dialect/Support/FIRContext.h"
#include "flang/Optimizer/Dialect/Support/KindMapping.h"
+#include "flang/Optimizer/Support/InternalNames.h"
#include "mlir/Conversion/LLVMCommon/TypeConverter.h"
#include "llvm/ADT/ScopeExit.h"
#include "llvm/Support/Debug.h"
@@ -164,7 +165,7 @@ mlir::Type LLVMTypeConverter::indexType() const {
// fir.type<name(p : TY'...){f : TY...}> --> llvm<"%name = { ty... }">
std::optional<mlir::LogicalResult> LLVMTypeConverter::convertRecordType(
fir::RecordType derived, llvm::SmallVectorImpl<mlir::Type> &results) {
- auto name = derived.getName();
+ auto name = fir::NameUniquer::dropTypeConversionMarkers(derived.getName());
auto st = mlir::LLVM::LLVMStructType::getIdentified(&getContext(), name);
auto &callStack = getCurrentThreadRecursiveStack();
diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp
index 6138c1f425d62c..4a7731eb4c4581 100644
--- a/flang/lib/Optimizer/Support/InternalNames.cpp
+++ b/flang/lib/Optimizer/Support/InternalNames.cpp
@@ -353,8 +353,8 @@ mangleTypeDescriptorKinds(llvm::ArrayRef<std::int64_t> kinds) {
static std::string getDerivedTypeObjectName(llvm::StringRef mangledTypeName,
const llvm::StringRef separator) {
- if (mangledTypeName.ends_with(boxprocSuffix))
- mangledTypeName = mangledTypeName.drop_back(boxprocSuffix.size());
+ mangledTypeName =
+ fir::NameUniquer::dropTypeConversionMarkers(mangledTypeName);
auto result = fir::NameUniquer::deconstruct(mangledTypeName);
if (result.first != fir::NameUniquer::NameKind::DERIVED_TYPE)
return "";
@@ -379,3 +379,10 @@ std::string fir::NameUniquer::getTypeDescriptorBindingTableName(
llvm::StringRef mangledTypeName) {
return getDerivedTypeObjectName(mangledTypeName, bindingTableSeparator);
}
+
+llvm::StringRef
+fir::NameUniquer::dropTypeConversionMarkers(llvm::StringRef mangledTypeName) {
+ if (mangledTypeName.ends_with(boxprocSuffix))
+ return mangledTypeName.drop_back(boxprocSuffix.size());
+ return mangledTypeName;
+}
diff --git a/flang/test/Lower/HLFIR/proc-pointer-comp-nopass.f90 b/flang/test/Lower/HLFIR/proc-pointer-comp-nopass.f90
new file mode 100644
index 00000000000000..ebb310f581c101
--- /dev/null
+++ b/flang/test/Lower/HLFIR/proc-pointer-comp-nopass.f90
@@ -0,0 +1,123 @@
+! Test lowering of NOPASS procedure pointers components.
+! RUN: bbc -emit-hlfir -polymorphic-type -o - %s | FileCheck %s
+
+module proc_comp_defs
+ interface
+ real function iface(x)
+ real :: x
+ end function
+ subroutine takes_proc_pointer(p)
+ import iface
+ procedure(iface), pointer :: p
+ end subroutine
+ end interface
+ type t
+ integer :: j
+ procedure(iface), nopass, pointer :: p
+ end type
+end module
+
+real function test1(x)
+ use proc_comp_defs, only : t
+ type(t) :: x
+ test1 = x%p(42.)
+end function
+! CHECK-LABEL: func.func @_QPtest1(
+! CHECK: %[[VAL_1:.*]] = fir.alloca f32 {bindc_name = "test1", uniq_name = "_QFtest1Etest1"}
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Etest1
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_4:.*]] = arith.constant 4.200000e+01 : f32
+! CHECK: %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]] {adapt.valuebyref} : (f32) -> (!fir.ref<f32>, !fir.ref<f32>, i1)
+! CHECK: %[[VAL_6:.*]] = hlfir.designate %[[VAL_3]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_6]] : !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]](%[[VAL_5]]#1) fastmath<contract> : (!fir.ref<f32>) -> f32
+! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<f32>, i1
+! CHECK: hlfir.assign %[[VAL_9]] to %[[VAL_2]]#0 : f32, !fir.ref<f32>
+
+subroutine test2(x)
+ use proc_comp_defs, only : t, iface
+ type(t) :: x
+ procedure(iface) :: ptarget
+ x%p => ptarget
+end subroutine
+! CHECK-LABEL: func.func @_QPtest2(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QPptarget) : (!fir.ref<f32>) -> f32
+! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+! CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+
+subroutine test3(x)
+ use proc_comp_defs, only : t
+ type(t) :: x
+ x%p => null()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest3(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_3:.*]] = fir.zero_bits () -> ()
+! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+! CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+
+subroutine test4(x)
+ use proc_comp_defs, only : t
+ type(t) :: x
+ x%p => x%p
+end subroutine
+! CHECK-LABEL: func.func @_QPtest4(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: fir.store %[[VAL_4]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+
+subroutine test5(x)
+ use proc_comp_defs, only : t, takes_proc_pointer
+ type(t) :: x
+ call takes_proc_pointer(x%p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest5(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK: fir.call @_QPtakes_proc_pointer(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
+
+subroutine test6(x)
+ use proc_comp_defs, only : t
+ type(t) :: x
+ nullify(x%p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest6(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+! CHECK: %[[VAL_3:.*]] = fir.zero_bits () -> ()
+! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+! CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+
+subroutine test7(x, y)
+ use proc_comp_defs, only : t
+ type(t) :: x, y
+ x = y
+end subroutine
+! CHECK-LABEL: func.func @_QPtest7(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Ey
+! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>, !fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>
+
+subroutine test8(x, y)
+ use proc_comp_defs, only : t
+ type(t) :: x(10), y(10)
+ x = y
+end subroutine
+! CHECK-LABEL: func.func @_QPtest8(
+! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_3:[a-z0-9]*]]) {{.*}}Ex
+! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {{.*}}Ey
+! CHECK: hlfir.assign %[[VAL_7]]#0 to %[[VAL_4]]#0 : !fir.ref<!fir.array<10x!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>>, !fir.ref<!fir.array<10x!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>>
diff --git a/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90 b/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90
new file mode 100644
index 00000000000000..ef5f45a27854bc
--- /dev/null
+++ b/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90
@@ -0,0 +1,81 @@
+! Test lowering of PASS procedure pointers components.
+! RUN: bbc -emit-hlfir -polymorphic-type -o - %s | FileCheck %s
+
+module m
+ type t
+ sequence
+ integer :: i
+ procedure(hello), pointer :: p
+ end type
+ type t2
+ integer :: i
+ procedure(goodbye), pointer :: p
+ end type
+
+ interface
+ subroutine takes_hello(p)
+ import :: hello
+ procedure(hello), pointer :: p
+ end subroutine
+ end interface
+contains
+subroutine hello(x)
+ type(t) :: x
+ print *, "hello"
+end subroutine
+subroutine goodbye(x)
+ class(t2) :: x
+ print *, "goodbye"
+end subroutine
+end module
+
+subroutine test1(x)
+ use m, only : t
+ type(t) :: x
+ call x%p()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest1(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>) -> ((!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ())
+! CHECK: fir.call %[[VAL_4]](%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()
+
+subroutine test2(x)
+ use m, only : t2
+ type(t2) :: x
+ call x%p()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest2(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#0 : (!fir.ref<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> !fir.box<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> !fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> !fir.ref<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>
+! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_4]]{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> !fir.ref<!fir.boxproc<(!fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.boxproc<(!fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.boxproc<(!fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> ()>) -> ((!fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> ())
+! CHECK: fir.call %[[VAL_7]](%[[VAL_3]]) fastmath<contract> : (!fir.class<!fir.type<_QMmTt2{i:i32,p:!fir.boxproc<(!fir.class<!fir.type<_QMmTt2>>) -> ()>}>>) -> ()
+
+subroutine test3(x)
+ use m, only : t, takes_hello
+ type(t) :: x
+ call takes_hello(x%p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest3(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>) -> !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK: fir.call @_QPtakes_hello(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
+
+subroutine test4(x, y)
+ use m, only : t
+ type(t) :: x, y
+ x%p => y%p
+end subroutine
+! CHECK-LABEL: func.func @_QPtest4(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Ey
+! CHECK: %[[VAL_4:.*]] = hlfir.designate %[[VAL_2]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_3]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_4]] : !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
diff --git a/flang/test/Lower/HLFIR/procedure-designators.f90 b/flang/test/Lower/HLFIR/procedure-designators.f90
index 99f0963dd1a855..e8e9edd24b8abc 100644
--- a/flang/test/Lower/HLFIR/procedure-designators.f90
+++ b/flang/test/Lower/HLFIR/procedure-designators.f90
@@ -126,10 +126,10 @@ subroutine test_call_character_dummy(proc)
! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_call_character_dummy(
! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".result"}
-! CHECK: %[[VAL_4:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
-! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
-! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>)
-! CHECK: %[[VAL_13:.*]] = fir.call %[[VAL_12]](%[[VAL_1]], {{.*}}
+! CHECK: %[[VAL_3:.*]] = fir.insert_value %{{.*}}, %c10{{.*}}, [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_4:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>)
+! CHECK: %[[VAL_13:.*]] = fir.call %[[VAL_5]](%[[VAL_1]], {{.*}}
subroutine test_present_simple_dummy(proc)
procedure(simple), optional :: proc
diff --git a/flang/test/Lower/HLFIR/procedure-pointer.f90 b/flang/test/Lower/HLFIR/procedure-pointer.f90
index 12bb7c67cd2d40..4ea71eef912a30 100644
--- a/flang/test/Lower/HLFIR/procedure-pointer.f90
+++ b/flang/test/Lower/HLFIR/procedure-pointer.f90
@@ -103,7 +103,7 @@ subroutine sub3()
! 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_7:.*]] = fir.load %[[VAL_3]]#0 : !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
@@ -138,7 +138,7 @@ subroutine sub4()
! 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_12:.*]] = fir.load %[[VAL_3]]#0 : !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
@@ -175,7 +175,7 @@ subroutine sub6()
! 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_6:.*]] = fir.load %[[VAL_3]]#0 : !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
>From a383c84a5a750e512060ac23beacda2522a33138 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 18 Dec 2023 04:22:11 -0800
Subject: [PATCH 2/5] turn an assert into TODO
---
flang/lib/Lower/ConvertProcedureDesignator.cpp | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index a4c09386a01c76..0806f78450dd6f 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -113,7 +113,10 @@ static hlfir::EntityWithAttributes designateProcedurePointerComponent(
auto recordType =
hlfir::getFortranElementType(base.getType()).cast<fir::RecordType>();
mlir::Type fieldType = recordType.getType(fieldName);
- assert(fieldType && "procedure component name is not known");
+ // FIXME: semantics is not expanding intermediate parent components in:
+ // call x%p() where p is a component of a parent type of x type.
+ if (!fieldType)
+ TODO(loc, "reference to procedure pointer component from parent type");
mlir::Type designatorType = fir::ReferenceType::get(fieldType);
mlir::Value compRef = builder.create<hlfir::DesignateOp>(
loc, designatorType, base, fieldName,
>From ce36b1f741fe60859790557e99117affa3557fcb Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 18 Dec 2023 09:11:59 -0800
Subject: [PATCH 3/5] Fix character procedure pointer component
The result argument is not placed in the list yet when looking for the
passed argument to lower the procedure reference. This caused an assert
to fire. Add an entry point to get the passed argument without checking
if the other arguments have been lowered yet.
Also visit fir.llvm_ptr type when rewriting fir.boxproc type (needed to
when a derived type with a procedure pointer component is "captured" in
a host procedure because it is used in an internal procedure).
---
flang/include/flang/Lower/CallInterface.h | 5 ++++
flang/lib/Lower/CallInterface.cpp | 9 ++++++
flang/lib/Lower/ConvertCall.cpp | 3 +-
.../lib/Optimizer/CodeGen/BoxedProcedure.cpp | 3 ++
.../Lower/HLFIR/proc-pointer-comp-pass.f90 | 29 +++++++++++++++++++
5 files changed, 47 insertions(+), 2 deletions(-)
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 420261b3dda552..e77ac4e179ba86 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -303,6 +303,11 @@ class CallerInterface : public CallInterface<CallerInterface> {
/// index.
std::optional<unsigned> getPassArgIndex() const;
+ /// Get the passed-object if any. Crashes if there is a passed object
+ /// but it was not placed in the inputs yet. Return a null value
+ /// otherwise.
+ mlir::Value getIfPassedArg() const;
+
/// Return the procedure symbol if this is a call to a user defined
/// procedure.
const Fortran::semantics::Symbol *getProcedureSymbol() const;
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 376718edb1ab5a..45487197fcbbbe 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -132,6 +132,15 @@ Fortran::lower::CallerInterface::getPassArgIndex() const {
return passArg;
}
+mlir::Value Fortran::lower::CallerInterface::getIfPassedArg() const {
+ if (std::optional<unsigned> passArg = getPassArgIndex()) {
+ assert(actualInputs.size() > *passArg && actualInputs[*passArg] &&
+ "passed arg was not set yet");
+ return actualInputs[*passArg];
+ }
+ return {};
+}
+
const Fortran::evaluate::ProcedureDesignator *
Fortran::lower::CallerInterface::getIfIndirectCall() const {
if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index a49dd98a34eb26..fd726c90c07bd0 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -168,14 +168,13 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
mlir::Value charFuncPointerLength;
if (const Fortran::evaluate::ProcedureDesignator *procDesignator =
caller.getIfIndirectCall()) {
- if (std::optional<unsigned> passArg = caller.getPassArgIndex()) {
+ if (mlir::Value passedArg = caller.getIfPassedArg()) {
// Procedure pointer component call with PASS argument. To avoid
// "double" lowering of the ComponentRef, semantics only place the
// ComponentRef in the ActualArguments, not in the ProcedureDesignator (
// that is only the component symbol).
// Fetch the passed argument and addresses of its procedure pointer
// component.
- mlir::Value passedArg = caller.getInputs()[*passArg];
funcPointer = Fortran::lower::derefPassProcPointerComponent(
loc, converter, *procDesignator, passedArg, symMap, stmtCtx);
} else {
diff --git a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
index 49df6efdee2d31..abf67746e04c9d 100644
--- a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
+++ b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
@@ -118,6 +118,9 @@ class BoxprocTypeRewriter : public mlir::TypeConverter {
});
addConversion(
[&](HeapType ty) { return HeapType::get(convertType(ty.getEleTy())); });
+ addConversion([&](fir::LLVMPointerType ty) {
+ return fir::LLVMPointerType::get(convertType(ty.getEleTy()));
+ });
addConversion(
[&](BoxType ty) { return BoxType::get(convertType(ty.getEleTy())); });
addConversion([&](ClassType ty) {
diff --git a/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90 b/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90
index ef5f45a27854bc..25e4393f9dac7c 100644
--- a/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90
+++ b/flang/test/Lower/HLFIR/proc-pointer-comp-pass.f90
@@ -11,6 +11,11 @@ module m
integer :: i
procedure(goodbye), pointer :: p
end type
+ type t3
+ sequence
+ character(4) :: c
+ procedure(char_func), pointer :: p
+ end type
interface
subroutine takes_hello(p)
@@ -27,6 +32,11 @@ subroutine goodbye(x)
class(t2) :: x
print *, "goodbye"
end subroutine
+function char_func(x)
+ type(t3) :: x
+ character(4) :: char_func
+ char_func = x%c
+end function
end module
subroutine test1(x)
@@ -79,3 +89,22 @@ subroutine test4(x, y)
! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_3]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
! CHECK: fir.store %[[VAL_6]] to %[[VAL_4]] : !fir.ref<!fir.boxproc<(!fir.ref<!fir.type<_QMmTt{i:i32,p:!fir.boxproc<(!fir.ref<!fir.type<_QMmTt>>) -> ()>}>>) -> ()>>
+
+subroutine test5(x)
+ use m, only : t3
+ type(t3) :: x
+ call takes_char(x%p())
+end subroutine
+! CHECK-LABEL: func.func @_QPtest5(
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.char<1,4> {bindc_name = ".result"}
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex
+! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_2]]#1{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt3{c:!fir.char<1,4>,p:!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3>>) -> !fir.boxchar<1>>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3{c:!fir.char<1,4>,p:!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3>>) -> !fir.boxchar<1>>}>>) -> !fir.boxchar<1>>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3{c:!fir.char<1,4>,p:!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3>>) -> !fir.boxchar<1>>}>>) -> !fir.boxchar<1>>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 4 : i64
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
+! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_8:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_7]] : index
+! CHECK: %[[VAL_9:.*]] = arith.select %[[VAL_8]], %[[VAL_6]], %[[VAL_7]] : index
+! CHECK: %[[VAL_10:.*]] = fir.call @llvm.stacksave.p0() fastmath<contract> : () -> !fir.ref<i8>
+! CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3{c:!fir.char<1,4>,p:!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3>>) -> !fir.boxchar<1>>}>>) -> !fir.boxchar<1>>) -> ((!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3{c:!fir.char<1,4>,p:!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3>>) -> !fir.boxchar<1>>}>>) -> !fir.boxchar<1>)
+! CHECK: %[[VAL_12:.*]] = fir.call %[[VAL_11]](%[[VAL_1]], %[[VAL_9]], %[[VAL_2]]#1) fastmath<contract> : (!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3{c:!fir.char<1,4>,p:!fir.boxproc<(!fir.ref<!fir.char<1,4>>, index, !fir.ref<!fir.type<_QMmTt3>>) -> !fir.boxchar<1>>}>>) -> !fir.boxchar<1>
>From b1a004f1f1d808b6e369a29d6c12bfebeefb452f Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Tue, 19 Dec 2023 02:10:47 -0800
Subject: [PATCH 4/5] convert fir.emboxproc result type
---
flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
index abf67746e04c9d..d4cc2b5732e4ca 100644
--- a/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
+++ b/flang/lib/Optimizer/CodeGen/BoxedProcedure.cpp
@@ -240,7 +240,8 @@ class BoxedProcedurePass
} else if (auto embox = mlir::dyn_cast<EmboxProcOp>(op)) {
// Rewrite all `fir.emboxproc` ops to either `fir.convert` or a thunk
// as required.
- mlir::Type toTy = embox.getType().cast<BoxProcType>().getEleTy();
+ mlir::Type toTy = typeConverter.convertType(
+ embox.getType().cast<BoxProcType>().getEleTy());
rewriter.setInsertionPoint(embox);
if (embox.getHost()) {
// Create the thunk.
>From f91148192b3c4202cab85eed80c34563807d3ee1 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Tue, 19 Dec 2023 07:09:40 -0800
Subject: [PATCH 5/5] drop type conversion markers when deconstructing names
Otherwise, the deconstruction will complain about unknown markers.
---
flang/lib/Optimizer/Support/InternalNames.cpp | 1 +
1 file changed, 1 insertion(+)
diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp
index 4a7731eb4c4581..74281ec1a3bb5b 100644
--- a/flang/lib/Optimizer/Support/InternalNames.cpp
+++ b/flang/lib/Optimizer/Support/InternalNames.cpp
@@ -240,6 +240,7 @@ llvm::StringRef fir::NameUniquer::doProgramEntry() {
std::pair<fir::NameUniquer::NameKind, fir::NameUniquer::DeconstructedName>
fir::NameUniquer::deconstruct(llvm::StringRef uniq) {
+ uniq = fir::NameUniquer::dropTypeConversionMarkers(uniq);
if (uniq.startswith("_Q")) {
llvm::SmallVector<std::string> modules;
llvm::SmallVector<std::string> procs;
More information about the cfe-commits
mailing list