[flang] Expand parent component in procedure pointer component refere… #78593
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
…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.
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-fir-hlfir Author: None (jeanPerier) Changes…nces For simplicity, lowering relies on semantics expansion of parent components in designators. This was not done in Do it and turn lowering TODO into fatal error. Full diff: https://github.com/llvm/llvm-project/pull/78593.diff 4 Files Affected:
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
|
|
@llvm/pr-subscribers-flang-semantics Author: None (jeanPerier) Changes…nces For simplicity, lowering relies on semantics expansion of parent components in designators. This was not done in Do it and turn lowering TODO into fatal error. Full diff: https://github.com/llvm/llvm-project/pull/78593.diff 4 Files Affected:
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
|
klausler
reviewed
Jan 18, 2024
| const Symbol &component, const semantics::Scope &scope, | ||
| bool C919AlreadyEnforced) { | ||
| if (!C919AlreadyEnforced && IsAllocatableOrPointer(component) && | ||
| base.Rank() > 0) { // C919b |
There was a problem hiding this comment.
C919b. Updated, thanks.
| ProcedureDesignator{std::move(*component)}, | ||
| std::move(arguments)}; | ||
| } | ||
| } |
There was a problem hiding this comment.
The current code always calls CalleeAndArgument. The new code might not. Is that what you want? Should there be an error if nothing can be returned?
There was a problem hiding this comment.
CalleeAndArgument ctor is not doing any extra semantics checking as far as I see, so if component cannot be created, something is wrong with the base/component and I do not see the point of attempting to build some invalid CalleeAndArguments.
All the kind of bad code I can think of do not reach the fallthrough, but better safe than sorry, I added an error in the fallthrough and returned nullopt (the later fallthrough would also emit error "Base of procedure component reference is not a derived-type object", but I do not think it would be correct if that point was reached).
klausler
approved these changes
Jan 18, 2024
jeanPerier
commented
Jan 19, 2024
klausler
added a commit
to klausler/llvm-project
that referenced
this pull request
Mar 11, 2024
llvm#78593 changed expression semantics to always include the names of parent components that were necessary to access an inherited component. This turns out to have broken calls to inherited NOPASS procedure bindings. Update the patch to omit explicit parent components when accessing bindings, while retaining them for component accesses (including procedure components).
klausler
added a commit
that referenced
this pull request
Mar 13, 2024
#78593 changed expression semantics to always include the names of parent components that were necessary to access an inherited component. This turns out to have broken calls to inherited NOPASS procedure bindings. Update the patch to omit explicit parent components when accessing bindings, while retaining them for component accesses (including procedure components).
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
…nces
For simplicity, lowering relies on semantics expansion of parent components in designators.
This was not done in
call x%p()wherepis a procedure component pointer of a parent component ofx.Do it and turn lowering TODO into fatal error.