[flang-commits] [flang] [flang] Expand parent component in procedure pointer component refere… (PR #78593)
via flang-commits
flang-commits at lists.llvm.org
Thu Jan 18 07:03:33 PST 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/78593
…nces
For simplicity, lowering relies on semantics expansion of parent components in designators.
This was not done in `call x%p()` where `p` is a procedure component pointer of a parent component of `x`.
Do it and turn lowering TODO into fatal error.
>From 104d90f58e1f1b184fd19d5056f756c928244148 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 18 Jan 2024 06:57:41 -0800
Subject: [PATCH] [flang] Expand parent component in procedure pointer
component references
For simplicity, lowering relies on semantics expansion of parent
components in designators.
This was not done in `call x%p()` where `p` is a procedure component
pointer of a parent component of `x`.
Do it and turn lowering TODO into fatal error.
---
flang/include/flang/Semantics/expression.h | 4 +--
.../lib/Lower/ConvertProcedureDesignator.cpp | 7 +++--
flang/lib/Semantics/expression.cpp | 22 +++++++++-----
.../HLFIR/proc-pointer-comp-in-parent.f90 | 30 +++++++++++++++++++
4 files changed, 51 insertions(+), 12 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/proc-pointer-comp-in-parent.f90
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 790d0a4d6d06414..64b4ed6924b7b88 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -327,8 +327,8 @@ class ExpressionAnalyzer {
const parser::SectionSubscript &);
std::vector<Subscript> AnalyzeSectionSubscripts(
const std::list<parser::SectionSubscript> &);
- std::optional<Component> CreateComponent(
- DataRef &&, const Symbol &, const semantics::Scope &);
+ std::optional<Component> CreateComponent(DataRef &&, const Symbol &,
+ const semantics::Scope &, bool C919AlreadyEnforced = false);
MaybeExpr CompleteSubscripts(ArrayRef &&);
MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
void CheckConstantSubscripts(ArrayRef &);
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 0806f78450dd6f1..5dd1d85cb9d2876 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -113,10 +113,11 @@ static hlfir::EntityWithAttributes designateProcedurePointerComponent(
auto recordType =
hlfir::getFortranElementType(base.getType()).cast<fir::RecordType>();
mlir::Type fieldType = recordType.getType(fieldName);
- // FIXME: semantics is not expanding intermediate parent components in:
- // call x%p() where p is a component of a parent type of x type.
+ // Note: semantics turns x%p() into x%t%p() when the procedure pointer
+ // component is part of parent component t.
if (!fieldType)
- TODO(loc, "reference to procedure pointer component from parent type");
+ fir::emitFatalError(loc,
+ "procedure pointer component not found in FIR type");
mlir::Type designatorType = fir::ReferenceType::get(fieldType);
mlir::Value compRef = builder.create<hlfir::DesignateOp>(
loc, designatorType, base, fieldName,
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index bfc380183e23f55..7f066412b48e9ba 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1296,9 +1296,11 @@ static NamedEntity IgnoreAnySubscripts(Designator<SomeDerived> &&designator) {
}
// Components of parent derived types are explicitly represented as such.
-std::optional<Component> ExpressionAnalyzer::CreateComponent(
- DataRef &&base, const Symbol &component, const semantics::Scope &scope) {
- if (IsAllocatableOrPointer(component) && base.Rank() > 0) { // C919b
+std::optional<Component> ExpressionAnalyzer::CreateComponent(DataRef &&base,
+ const Symbol &component, const semantics::Scope &scope,
+ bool C919AlreadyEnforced) {
+ if (!C919AlreadyEnforced && IsAllocatableOrPointer(component) &&
+ base.Rank() > 0) { // C919b
Say("An allocatable or pointer component reference must be applied to a scalar base"_err_en_US);
}
if (&component.owner() == &scope) {
@@ -1313,7 +1315,7 @@ std::optional<Component> ExpressionAnalyzer::CreateComponent(
parentType->derivedTypeSpec().scope()}) {
return CreateComponent(
DataRef{Component{std::move(base), *parentComponent}},
- component, *parentScope);
+ component, *parentScope, C919AlreadyEnforced);
}
}
}
@@ -2391,9 +2393,15 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
ProcedureDesignator{*resolution}, std::move(arguments)};
} else if (dataRef.has_value()) {
if (sym->attrs().test(semantics::Attr::NOPASS)) {
- return CalleeAndArguments{
- ProcedureDesignator{Component{std::move(*dataRef), *sym}},
- std::move(arguments)};
+ const auto *dtSpec{GetDerivedTypeSpec(dtExpr->GetType())};
+ if (dtSpec && dtSpec->scope()) {
+ if (auto component{CreateComponent(std::move(*dataRef), *sym,
+ *dtSpec->scope(), /*C919AlreadyEnforced=*/true)}) {
+ return CalleeAndArguments{
+ ProcedureDesignator{std::move(*component)},
+ std::move(arguments)};
+ }
+ }
} else {
AddPassArg(arguments,
Expr<SomeDerived>{Designator<SomeDerived>{std::move(*dataRef)}},
diff --git a/flang/test/Lower/HLFIR/proc-pointer-comp-in-parent.f90 b/flang/test/Lower/HLFIR/proc-pointer-comp-in-parent.f90
new file mode 100644
index 000000000000000..5b37b6a8651ddde
--- /dev/null
+++ b/flang/test/Lower/HLFIR/proc-pointer-comp-in-parent.f90
@@ -0,0 +1,30 @@
+! Test that parent components are made explicit in reference to
+! procedure pointer from parent type.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+module type_defs
+ interface
+ subroutine s1
+ end subroutine
+ real function s2()
+ end function
+ end interface
+ type :: t
+ procedure(s1), pointer, nopass :: p1
+ procedure(s2), pointer, nopass :: p2
+ end type
+ type, extends(t) :: t2
+ end type
+end module
+
+! CHECK-LABEL: func.func @_QPtest(
+subroutine test (x)
+use type_defs, only : t2
+type(t2) :: x
+call x%p1()
+! CHECK: %[[T_REF1:.*]] = hlfir.designate %{{.*}}{"t"}
+! CHECK: hlfir.designate %[[T_REF1]]{"p1"}
+print *, x%p2()
+! CHECK: %[[T_REF2:.*]] = hlfir.designate %{{.*}}{"t"}
+! CHECK: hlfir.designate %[[T_REF2]]{"p2"}
+end subroutine
More information about the flang-commits
mailing list