[flang-commits] [flang] [flang] add extra component information in fir.type_info (PR #96746)
via flang-commits
flang-commits at lists.llvm.org
Wed Jun 26 03:07:23 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/96746
fir.type does not contain all Fortran level information about components. For instance, component lower bounds and default initial value are lost. For correctness purpose, this does not matter because this information is "applied" in lowering (e.g., when addressing the components, the lower bounds are reflected in the hlfir.designate).
However, this "loss" of information will prevent the generation of correct debug info for the type (needs to know about lower bounds). The initial value could help building some optimization pass to get rid of initialization runtime calls.
This patch adds lower bound and initial value information into fir.type_info via a new fir.dt_component operation. This operation is generated only for component that needs it, which helps keeping the IR small for "boring" types.
In general, adding Fortran level info in fir.type_info will allow delaying the generation of "type descriptors" gobals that are very verbose in FIR and make it hard to work with FIR dumps from applications with many derived types.
>From 3b7f342c382cae075d735cabfc40f98ddbac3c45 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 26 Jun 2024 02:25:35 -0700
Subject: [PATCH] [flang] add extra component information in fir.type_info
---
.../flang/Optimizer/Builder/FIRBuilder.h | 4 +
.../include/flang/Optimizer/Dialect/FIROps.td | 24 +++-
.../flang/Optimizer/Support/InternalNames.h | 6 +
flang/include/flang/Optimizer/Support/Utils.h | 23 ++++
flang/lib/Lower/Bridge.cpp | 119 +++++++++++++++---
flang/lib/Optimizer/Builder/FIRBuilder.cpp | 17 +++
flang/lib/Optimizer/Dialect/FIROps.cpp | 1 +
flang/lib/Optimizer/Support/CMakeLists.txt | 1 +
flang/lib/Optimizer/Support/InternalNames.cpp | 9 ++
flang/lib/Optimizer/Support/Utils.cpp | 52 ++++++++
flang/test/Fir/fir-ops.fir | 7 ++
.../test/Lower/HLFIR/type-info-components.f90 | 55 ++++++++
12 files changed, 302 insertions(+), 16 deletions(-)
create mode 100644 flang/lib/Optimizer/Support/Utils.cpp
create mode 100644 flang/test/Lower/HLFIR/type-info-components.f90
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
index f9ef8b7566299..ea35b298c0209 100644
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -286,6 +286,10 @@ class FirOpBuilder : public mlir::OpBuilder, public mlir::OpBuilder::Listener {
fir::StringLitOp createStringLitOp(mlir::Location loc,
llvm::StringRef string);
+ std::pair<fir::TypeInfoOp, mlir::OpBuilder::InsertPoint>
+ createTypeInfoOp(mlir::Location loc, fir::RecordType recordType,
+ fir::RecordType parentType);
+
//===--------------------------------------------------------------------===//
// Linkage helpers (inline). The default linkage is external.
//===--------------------------------------------------------------------===//
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index baf095263479b..5b03806614f9b 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -2956,7 +2956,10 @@ def fir_TypeInfoOp : fir_Op<"type_info",
let hasVerifier = 1;
- let regions = (region MaxSizedRegion<1>:$dispatch_table);
+ let regions = (region
+ MaxSizedRegion<1>:$dispatch_table,
+ MaxSizedRegion<1>:$component_info
+ );
let builders = [
OpBuilder<(ins "fir::RecordType":$type, "fir::RecordType":$parent_type,
@@ -2967,6 +2970,7 @@ def fir_TypeInfoOp : fir_Op<"type_info",
$sym_name (`noinit` $no_init^)? (`nodestroy` $no_destroy^)?
(`nofinal` $no_final^)? (`extends` $parent_type^)? attr-dict `:` $type
(`dispatch_table` $dispatch_table^)?
+ (`component_info` $component_info^)?
}];
let extraClassDeclaration = [{
@@ -3010,6 +3014,24 @@ def fir_DTEntryOp : fir_Op<"dt_entry", [HasParent<"TypeInfoOp">]> {
}];
}
+def fir_DTComponentOp : fir_Op<"dt_component", [HasParent<"TypeInfoOp">]> {
+ let summary = "define extra information about a component inside fir.type_info";
+
+ let description = [{
+ ```
+ fir.dt_component i lbs [-1,2] init @init_val
+ ```
+ }];
+
+ let arguments = (ins
+ StrAttr:$name,
+ OptionalAttr<DenseI64ArrayAttr>:$lower_bounds,
+ OptionalAttr<FlatSymbolRefAttr>:$init_val
+ );
+
+ let assemblyFormat = "$name (`lbs` $lower_bounds^)? (`init` $init_val^)? attr-dict";
+}
+
def fir_AbsentOp : fir_OneResultOp<"absent", [NoMemoryEffect]> {
let summary = "create value to be passed for absent optional function argument";
let description = [{
diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h
index 23a03854c4abd..ff23510922372 100644
--- a/flang/include/flang/Optimizer/Support/InternalNames.h
+++ b/flang/include/flang/Optimizer/Support/InternalNames.h
@@ -15,6 +15,7 @@
#include <optional>
static constexpr llvm::StringRef typeDescriptorSeparator = ".dt.";
+static constexpr llvm::StringRef componentInitSeparator = ".di.";
static constexpr llvm::StringRef bindingTableSeparator = ".v.";
static constexpr llvm::StringRef boxprocSuffix = "UnboxProc";
@@ -156,6 +157,11 @@ struct NameUniquer {
static std::string
getTypeDescriptorBindingTableName(llvm::StringRef mangledTypeName);
+ /// Given a mangled derived type name and a component name, get the name of
+ /// the global object containing the component default initialization.
+ static std::string getComponentInitName(llvm::StringRef mangledTypeName,
+ llvm::StringRef componentName);
+
/// 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.
diff --git a/flang/include/flang/Optimizer/Support/Utils.h b/flang/include/flang/Optimizer/Support/Utils.h
index d8bcb5fae034d..ae95a26be1d86 100644
--- a/flang/include/flang/Optimizer/Support/Utils.h
+++ b/flang/include/flang/Optimizer/Support/Utils.h
@@ -137,6 +137,29 @@ inline void intrinsicTypeTODO(fir::FirOpBuilder &builder, mlir::Type type,
" in " + intrinsicName);
}
+/// Find the fir.type_info that was created for this \p recordType in \p module,
+/// if any. \p symbolTable can be provided to speed-up the lookup. This tool
+/// will match record type even if they have been "altered" in type conversion
+/// passes.
+fir::TypeInfoOp
+lookupTypeInfoOp(fir::RecordType recordType, mlir::ModuleOp module,
+ const mlir::SymbolTable *symbolTable = nullptr);
+
+/// Find the fir.type_info named \p name in \p module, if any. \p symbolTable
+/// can be provided to speed-up the lookup. Prefer using the equivalent with a
+/// RecordType argument unless it is certain \p name has not been altered by a
+/// pass rewriting fir.type (see NameUniquer::dropTypeConversionMarkers).
+fir::TypeInfoOp
+lookupTypeInfoOp(llvm::StringRef name, mlir::ModuleOp module,
+ const mlir::SymbolTable *symbolTable = nullptr);
+
+/// Returns all lower bounds of \p component if it is an array component of \p
+/// recordType with non default lower bounds. Returns nullopt if this is not an
+/// array componnet of \p recordType or if its lower bounds are all ones.
+std::optional<llvm::ArrayRef<int64_t>> getComponentLowerBoundsIfNonDefault(
+ fir::RecordType recordType, llvm::StringRef component,
+ mlir::ModuleOp module, const mlir::SymbolTable *symbolTable = nullptr);
+
} // namespace fir
#endif // FORTRAN_OPTIMIZER_SUPPORT_UTILS_H
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 404d1f6d39446..25b4ce02fd500 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -148,6 +148,71 @@ struct ConstructContext {
bool pushedScope = false; // was a scoped pushed for this construct?
};
+/// Helper to gather the lower bounds of array components with non deferred
+/// shape when they are not all ones. Return an empty array attribute otherwise.
+static mlir::DenseI64ArrayAttr
+gatherComponentNonDefaultLowerBounds(mlir::Location loc,
+ mlir::MLIRContext *mlirContext,
+ const Fortran::semantics::Symbol &sym) {
+ if (Fortran::semantics::IsAllocatableOrObjectPointer(&sym))
+ return {};
+ mlir::DenseI64ArrayAttr lbs_attr;
+ if (const auto *objDetails =
+ sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
+ llvm::SmallVector<std::int64_t> lbs;
+ bool hasNonDefaultLbs = false;
+ for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
+ if (auto lb = bounds.lbound().GetExplicit()) {
+ if (auto constant = Fortran::evaluate::ToInt64(*lb)) {
+ hasNonDefaultLbs |= (*constant != 1);
+ lbs.push_back(*constant);
+ } else {
+ TODO(loc, "generate fir.dt_component for length parametrized derived "
+ "types");
+ }
+ }
+ if (hasNonDefaultLbs) {
+ assert(static_cast<int>(lbs.size()) == sym.Rank() &&
+ "expected component bounds to be constant or deferred");
+ lbs_attr = mlir::DenseI64ArrayAttr::get(mlirContext, lbs);
+ }
+ }
+ return lbs_attr;
+}
+
+// Helper class to generate name of fir.global containing component explicit
+// default value for objects, and initial procedure target for procedure pointer
+// components.
+static mlir::FlatSymbolRefAttr gatherComponentInit(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &sym, fir::RecordType derivedType) {
+ mlir::MLIRContext *mlirContext = &converter.getMLIRContext();
+ // Return procedure target mangled name for procedure pointer components.
+ if (const auto *procPtr =
+ sym.detailsIf<Fortran::semantics::ProcEntityDetails>()) {
+ if (std::optional<const Fortran::semantics::Symbol *> maybeInitSym =
+ procPtr->init()) {
+ // So far, do not make distinction between p => NULL() and p without init,
+ // f18 always initialize pointers to NULL anyway.
+ if (!*maybeInitSym)
+ return {};
+ return mlir::FlatSymbolRefAttr::get(mlirContext,
+ converter.mangleName(**maybeInitSym));
+ }
+ }
+
+ const auto *objDetails =
+ sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
+ if (!objDetails || !objDetails->init().has_value())
+ return {};
+ // Object component initial value. Semantic package component object default
+ // value into compiler generated symbols that are lowered as read-only
+ // fir.global. Get the name of this global.
+ std::string name = fir::NameUniquer::getComponentInitName(
+ derivedType.getName(), toStringRef(sym.name()));
+ return mlir::FlatSymbolRefAttr::get(mlirContext, name);
+}
+
/// Helper class to generate the runtime type info global data and the
/// fir.type_info operations that contain the dipatch tables (if any).
/// The type info global data is required to describe the derived type to the
@@ -213,15 +278,14 @@ class TypeInfoConverter {
parentType = mlir::cast<fir::RecordType>(converter.genType(*parent));
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- mlir::ModuleOp module = builder.getModule();
- fir::TypeInfoOp dt =
- module.lookupSymbol<fir::TypeInfoOp>(info.type.getName());
- if (dt)
- return; // Already created.
- auto insertPt = builder.saveInsertionPoint();
- builder.setInsertionPoint(module.getBody(), module.getBody()->end());
- dt = builder.create<fir::TypeInfoOp>(info.loc, info.type, parentType);
-
+ fir::TypeInfoOp dt;
+ mlir::OpBuilder::InsertPoint insertPointIfCreated;
+ std::tie(dt, insertPointIfCreated) =
+ builder.createTypeInfoOp(info.loc, info.type, parentType);
+ if (!insertPointIfCreated.isSet())
+ return; // fir.type_info was already built in a previous call.
+
+ // Set init, destroy, and nofinal attributes.
if (!info.typeSpec.HasDefaultInitialization(/*ignoreAllocatable=*/false,
/*ignorePointer=*/false))
dt->setAttr(dt.getNoInitAttrName(), builder.getUnitAttr());
@@ -230,13 +294,12 @@ class TypeInfoConverter {
if (!Fortran::semantics::MayRequireFinalization(info.typeSpec))
dt->setAttr(dt.getNoFinalAttrName(), builder.getUnitAttr());
- const Fortran::semantics::Scope *scope = info.typeSpec.scope();
- if (!scope)
- scope = info.typeSpec.typeSymbol().scope();
- assert(scope && "failed to find type scope");
+ const Fortran::semantics::Scope &derivedScope =
+ DEREF(info.typeSpec.GetScope());
+ // Fill binding table region if the derived type has bindings.
Fortran::semantics::SymbolVector bindings =
- Fortran::semantics::CollectBindings(*scope);
+ Fortran::semantics::CollectBindings(derivedScope);
if (!bindings.empty()) {
builder.createBlock(&dt.getDispatchTable());
for (const Fortran::semantics::SymbolRef &binding : bindings) {
@@ -252,7 +315,33 @@ class TypeInfoConverter {
}
builder.create<fir::FirEndOp>(info.loc);
}
- builder.restoreInsertionPoint(insertPt);
+ // Gather info about components that is not reflected in fir.type and may be
+ // needed later: component initial values and array component non default
+ // lower bounds.
+ mlir::Block *componentInfo = nullptr;
+ for (const auto &componentName :
+ info.typeSpec.typeSymbol()
+ .get<Fortran::semantics::DerivedTypeDetails>()
+ .componentNames()) {
+ auto scopeIter = derivedScope.find(componentName);
+ assert(scopeIter != derivedScope.cend() &&
+ "failed to find derived type component symbol");
+ const Fortran::semantics::Symbol &component = scopeIter->second.get();
+ mlir::FlatSymbolRefAttr init_val =
+ gatherComponentInit(info.loc, converter, component, info.type);
+ mlir::DenseI64ArrayAttr lbs = gatherComponentNonDefaultLowerBounds(
+ info.loc, builder.getContext(), component);
+ if (init_val || lbs) {
+ if (!componentInfo)
+ componentInfo = builder.createBlock(&dt.getComponentInfo());
+ auto compName = mlir::StringAttr::get(builder.getContext(),
+ toStringRef(component.name()));
+ builder.create<fir::DTComponentOp>(info.loc, compName, lbs, init_val);
+ }
+ }
+ if (componentInfo)
+ builder.create<fir::FirEndOp>(info.loc);
+ builder.restoreInsertionPoint(insertPointIfCreated);
}
/// Store the front-end data that will be required to generate the type info
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index 4a1772ac91e6f..2ea302d188018 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -19,6 +19,7 @@
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/Support/FatalError.h"
#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Optimizer/Support/Utils.h"
#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
#include "mlir/Dialect/OpenACC/OpenACC.h"
#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
@@ -364,6 +365,22 @@ fir::GlobalOp fir::FirOpBuilder::createGlobal(
return glob;
}
+std::pair<fir::TypeInfoOp, mlir::OpBuilder::InsertPoint>
+fir::FirOpBuilder::createTypeInfoOp(mlir::Location loc,
+ fir::RecordType recordType,
+ fir::RecordType parentType) {
+ mlir::ModuleOp module = getModule();
+ if (fir::TypeInfoOp typeInfo =
+ fir::lookupTypeInfoOp(recordType.getName(), module, symbolTable))
+ return {typeInfo, InsertPoint{}};
+ InsertPoint insertPoint = saveInsertionPoint();
+ setInsertionPoint(module.getBody(), module.getBody()->end());
+ auto typeInfo = create<fir::TypeInfoOp>(loc, recordType, parentType);
+ if (symbolTable)
+ symbolTable->insert(typeInfo);
+ return {typeInfo, insertPoint};
+}
+
mlir::Value fir::FirOpBuilder::convertWithSemantics(
mlir::Location loc, mlir::Type toTy, mlir::Value val,
bool allowCharacterConversion, bool allowRebox) {
diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 84711c5406581..c3c10967673d6 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -1579,6 +1579,7 @@ void fir::TypeInfoOp::build(mlir::OpBuilder &builder,
fir::RecordType parentType,
llvm::ArrayRef<mlir::NamedAttribute> attrs) {
result.addRegion();
+ result.addRegion();
result.addAttribute(mlir::SymbolTable::getSymbolAttrName(),
builder.getStringAttr(type.getName()));
result.addAttribute(getTypeAttrName(result.name), mlir::TypeAttr::get(type));
diff --git a/flang/lib/Optimizer/Support/CMakeLists.txt b/flang/lib/Optimizer/Support/CMakeLists.txt
index 55f5718a90b85..eb93975c71b7e 100644
--- a/flang/lib/Optimizer/Support/CMakeLists.txt
+++ b/flang/lib/Optimizer/Support/CMakeLists.txt
@@ -5,6 +5,7 @@ add_flang_library(FIRSupport
DataLayout.cpp
InitFIR.cpp
InternalNames.cpp
+ Utils.cpp
DEPENDS
FIROpsIncGen
diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp
index 65046ea30252e..b2e2cd38f48e6 100644
--- a/flang/lib/Optimizer/Support/InternalNames.cpp
+++ b/flang/lib/Optimizer/Support/InternalNames.cpp
@@ -381,6 +381,15 @@ std::string fir::NameUniquer::getTypeDescriptorBindingTableName(
return getDerivedTypeObjectName(mangledTypeName, bindingTableSeparator);
}
+std::string
+fir::NameUniquer::getComponentInitName(llvm::StringRef mangledTypeName,
+ llvm::StringRef componentName) {
+
+ std::string prefix =
+ getDerivedTypeObjectName(mangledTypeName, componentInitSeparator);
+ return prefix + "." + componentName.str();
+}
+
llvm::StringRef
fir::NameUniquer::dropTypeConversionMarkers(llvm::StringRef mangledTypeName) {
if (mangledTypeName.ends_with(boxprocSuffix))
diff --git a/flang/lib/Optimizer/Support/Utils.cpp b/flang/lib/Optimizer/Support/Utils.cpp
new file mode 100644
index 0000000000000..5d663e28336c0
--- /dev/null
+++ b/flang/lib/Optimizer/Support/Utils.cpp
@@ -0,0 +1,52 @@
+//===-- Utils.cpp ---------------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Support/Utils.h"
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+
+fir::TypeInfoOp fir::lookupTypeInfoOp(fir::RecordType recordType,
+ mlir::ModuleOp module,
+ const mlir::SymbolTable *symbolTable) {
+ // fir.type_info was created with the mangled name of the derived type.
+ // It is the same as the name in the related fir.type, except when a pass
+ // lowered the fir.type (e.g., when lowering fir.boxproc type if the type has
+ // pointer procedure components), in which case suffix may have been added to
+ // the fir.type name. Get rid of them when looking up for the fir.type_info.
+ llvm::StringRef originalMangledTypeName =
+ fir::NameUniquer::dropTypeConversionMarkers(recordType.getName());
+ return fir::lookupTypeInfoOp(originalMangledTypeName, module, symbolTable);
+}
+
+fir::TypeInfoOp fir::lookupTypeInfoOp(llvm::StringRef name,
+ mlir::ModuleOp module,
+ const mlir::SymbolTable *symbolTable) {
+ if (symbolTable)
+ if (auto typeInfo = symbolTable->lookup<fir::TypeInfoOp>(name))
+ return typeInfo;
+ return module.lookupSymbol<fir::TypeInfoOp>(name);
+}
+
+std::optional<llvm::ArrayRef<int64_t>> fir::getComponentLowerBoundsIfNonDefault(
+ fir::RecordType recordType, llvm::StringRef component,
+ mlir::ModuleOp module, const mlir::SymbolTable *symbolTable) {
+ fir::TypeInfoOp typeInfo =
+ fir::lookupTypeInfoOp(recordType, module, symbolTable);
+ if (!typeInfo || typeInfo.getComponentInfo().empty())
+ return std::nullopt;
+ for (auto componentInfo :
+ typeInfo.getComponentInfo().getOps<fir::DTComponentOp>())
+ if (componentInfo.getName() == component)
+ return componentInfo.getLowerBounds();
+ return std::nullopt;
+}
diff --git a/flang/test/Fir/fir-ops.fir b/flang/test/Fir/fir-ops.fir
index ecc5c4ecff35d..b8ae566e87a1f 100644
--- a/flang/test/Fir/fir-ops.fir
+++ b/flang/test/Fir/fir-ops.fir
@@ -460,6 +460,13 @@ fir.type_info @dispatch_tbl : !fir.type<dispatch_tbl{i:i32}> dispatch_table {
// CHECK-LABEL: fir.type_info @test_type_info noinit nodestroy nofinal extends !fir.type<parent{i:i32}> : !fir.type<test_type_info{i:i32,j:f32}>
fir.type_info @test_type_info noinit nodestroy nofinal extends !fir.type<parent{i:i32}> : !fir.type<test_type_info{i:i32,j:f32}>
+// CHECK-LABEL: fir.type_info @cpinfo : !fir.type<cpinfo{comp_i:!fir.array<10x20xi32>}> component_info {
+// CHECK: fir.dt_component "component_info" lbs [2, 3]
+// CHECK: }
+fir.type_info @cpinfo : !fir.type<cpinfo{comp_i:!fir.array<10x20xi32>}> component_info {
+ fir.dt_component "component_info" lbs [2, 3]
+}
+
// CHECK-LABEL: func @compare_complex(
// CHECK-SAME: [[VAL_151:%.*]]: !fir.complex<16>, [[VAL_152:%.*]]: !fir.complex<16>) {
func.func @compare_complex(%a : !fir.complex<16>, %b : !fir.complex<16>) {
diff --git a/flang/test/Lower/HLFIR/type-info-components.f90 b/flang/test/Lower/HLFIR/type-info-components.f90
new file mode 100644
index 0000000000000..ee36f9cf6588f
--- /dev/null
+++ b/flang/test/Lower/HLFIR/type-info-components.f90
@@ -0,0 +1,55 @@
+! Test generation of fir.dt_component
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+subroutine test_1(x)
+ integer, save, target :: my_target
+ procedure() :: my_proc
+ type :: sometype
+ integer :: i(-1:8) = 42
+ integer :: j(1:8)
+ integer, allocatable :: alloc(:)
+ integer, pointer :: p => my_target
+ integer, pointer :: p2 => NULL()
+ integer, pointer :: p3
+ procedure(), pointer, nopass :: proc_p => my_proc
+ procedure(), pointer, nopass :: proc_p2 => NULL()
+ procedure(), pointer, nopass :: proc_p3
+ end type
+ type(sometype) :: x
+end subroutine
+! CHECK-LABEL: fir.type_info @_QFtest_1Tsometype
+! CHECK-SAME component_info {
+! CHECK: fir.dt_component "i" lbs [-1] init @_QFtest_1E.di.sometype.i
+! CHECK-NOT: fir.dt_component "j"
+! CHECK: fir.dt_component "p" init @_QFtest_1E.di.sometype.p
+! CHECK: fir.dt_component "p2" init @_QFtest_1E.di.sometype.p2
+! CHECK: fir.dt_component "proc_p" init @_QPmy_proc
+! CHECK: }
+
+subroutine test_nesting(x)
+ type some_sub_type
+ integer :: i = 42
+ end type
+ type sometype2
+ type(some_sub_type) :: nested
+ end type
+ type(sometype2) :: x
+end subroutine
+! CHECK-LABEL: fir.type_info @_QFtest_nestingTsome_sub_type
+! CHECK-SAME component_info {
+! CHECK: fir.dt_component "i" init @_QFtest_nestingE.di.some_sub_type.i
+! CHECK: }
+
+! CHECK: fir.type_info @_QFtest_nestingTsometype2
+! CHECK-NOT: fir.dt_component
+
+
+subroutine data_like(x)
+ type sometype3
+ integer :: i/42/
+ end type
+ type(sometype3) :: x
+end subroutine
+! CHECK-LABEL: fir.type_info @_QFdata_likeTsometype3
+! CHECK-SAME component_info {
+! CHECK: fir.dt_component "i" init @_QFdata_likeE.di.sometype3.i
+! CHECK: }
More information about the flang-commits
mailing list