[flang-commits] [flang] [flang] Catch type-bound generic with inherited indistinguishable spe… (PR #128980)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Feb 26 17:26:48 PST 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/128980
…cific
When checking generic procedures for indistinguishable specific procedures, don't neglect to include specific procedures from any accessible instance of the generic procedure inherited from its parent type..
Fixes https://github.com/llvm/llvm-project/issues/128760.
>From 9162026020e34c2d884d24397f19d26212f00a9e Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 26 Feb 2025 17:23:11 -0800
Subject: [PATCH] [flang] Catch type-bound generic with inherited
indistinguishable specific
When checking generic procedures for indistinguishable specific procedures,
don't neglect to include specific procedures from any accessible instance
of the generic procedure inherited from its parent type..
Fixes https://github.com/llvm/llvm-project/issues/128760.
---
flang/lib/Semantics/check-declarations.cpp | 43 +++++++++++++++++++---
flang/test/Semantics/generic07.f90 | 2 +-
flang/test/Semantics/resolve117.f90 | 23 +++++++-----
3 files changed, 53 insertions(+), 15 deletions(-)
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index bf4dc16a15b4a..36704575d961d 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -33,6 +33,8 @@ using characteristics::DummyProcedure;
using characteristics::FunctionResult;
using characteristics::Procedure;
+class DistinguishabilityHelper;
+
class CheckHelper {
public:
explicit CheckHelper(SemanticsContext &c) : context_{c} {}
@@ -89,6 +91,8 @@ class CheckHelper {
const SourceName &, const Symbol &, const Procedure &, std::size_t);
bool CheckDefinedAssignment(const Symbol &, const Procedure &);
bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int);
+ void CollectSpecifics(
+ DistinguishabilityHelper &, const Symbol &, const GenericDetails &);
void CheckSpecifics(const Symbol &, const GenericDetails &);
void CheckEquivalenceSet(const EquivalenceSet &);
void CheckEquivalenceObject(const EquivalenceObject &);
@@ -1857,10 +1861,9 @@ void CheckHelper::CheckGeneric(
}
// Check that the specifics of this generic are distinguishable from each other
-void CheckHelper::CheckSpecifics(
+void CheckHelper::CollectSpecifics(DistinguishabilityHelper &helper,
const Symbol &generic, const GenericDetails &details) {
GenericKind kind{details.kind()};
- DistinguishabilityHelper helper{context_};
for (const Symbol &specific : details.specificProcs()) {
if (specific.attrs().test(Attr::ABSTRACT)) {
if (auto *msg{messages_.Say(generic.name(),
@@ -1915,6 +1918,23 @@ void CheckHelper::CheckSpecifics(
}
}
}
+ if (const Scope * parent{generic.owner().GetDerivedTypeParent()}) {
+ if (const Symbol * inherited{parent->FindComponent(generic.name())}) {
+ if (IsAccessible(*inherited, generic.owner().parent())) {
+ if (const auto *details{inherited->detailsIf<GenericDetails>()}) {
+ // Include specifics of inherited generic of the same name, too
+ CollectSpecifics(helper, *inherited, *details);
+ }
+ }
+ }
+ }
+}
+
+void CheckHelper::CheckSpecifics(
+ const Symbol &generic, const GenericDetails &details) {
+ GenericKind kind{details.kind()};
+ DistinguishabilityHelper helper{context_};
+ CollectSpecifics(helper, generic, details);
helper.Check(generic.owner());
}
@@ -3884,10 +3904,11 @@ evaluate::Shape SubprogramMatchHelper::FoldShape(const evaluate::Shape &shape) {
}
void DistinguishabilityHelper::Add(const Symbol &generic, GenericKind kind,
- const Symbol &ultimateSpecific, const Procedure &procedure) {
- if (!context_.HasError(ultimateSpecific)) {
+ const Symbol &specific, const Procedure &procedure) {
+ const Symbol &ultimate{specific.GetUltimate()};
+ if (!context_.HasError(ultimate)) {
nameToSpecifics_[generic.name()].emplace(
- &ultimateSpecific, ProcedureInfo{kind, procedure});
+ &ultimate, ProcedureInfo{kind, procedure});
}
}
@@ -3902,6 +3923,18 @@ void DistinguishabilityHelper::Check(const Scope &scope) {
const auto &[ultimate, procInfo]{*iter1};
const auto &[kind, proc]{procInfo};
for (auto iter2{iter1}; ++iter2 != info.end();) {
+ if (&*ultimate == &*iter2->first) {
+ continue; // ok, actually the same procedure
+ } else if (const auto *binding1{
+ ultimate->detailsIf<ProcBindingDetails>()}) {
+ if (const auto *binding2{
+ iter2->first->detailsIf<ProcBindingDetails>()}) {
+ if (&binding1->symbol().GetUltimate() ==
+ &binding2->symbol().GetUltimate()) {
+ continue; // ok, bindings resolve identically
+ }
+ }
+ }
auto distinguishable{kind.IsName()
? evaluate::characteristics::Distinguishable
: evaluate::characteristics::DistinguishableOpOrAssign};
diff --git a/flang/test/Semantics/generic07.f90 b/flang/test/Semantics/generic07.f90
index e7486c02a7d2b..5566c0f82633d 100644
--- a/flang/test/Semantics/generic07.f90
+++ b/flang/test/Semantics/generic07.f90
@@ -74,7 +74,7 @@ program test
interface distinguishable3
procedure :: s1a, s1b
end interface
- !ERROR: Generic 'indistinguishable' may not have specific procedures 's2b' and 's2a' as their interfaces are not distinguishable
+ !ERROR: Generic 'indistinguishable' may not have specific procedures 's2a' and 's2b' as their interfaces are not distinguishable
interface indistinguishable
procedure :: s2a, s2b
end interface
diff --git a/flang/test/Semantics/resolve117.f90 b/flang/test/Semantics/resolve117.f90
index 3e3a813c0921b..b7b0ce7db6b0e 100644
--- a/flang/test/Semantics/resolve117.f90
+++ b/flang/test/Semantics/resolve117.f90
@@ -5,23 +5,28 @@ module m
integer, kind :: k = 4
real x
contains
- procedure, nopass :: tbp => sub
- generic :: gen => tbp
+ procedure, nopass :: tbp => sub1
+ generic :: gen1 => tbp
+ generic :: gen2 => tbp
end type
type, extends(base1) :: ext1
contains
- procedure, nopass :: sub
+ procedure, nopass :: sub1, sub2
!ERROR: Type parameter, component, or procedure binding 'base1' already defined in this type
- generic :: base1 => sub
+ generic :: base1 => sub1
!ERROR: Type bound generic procedure 'k' may not have the same name as a non-generic symbol inherited from an ancestor type
- generic :: k => sub
+ generic :: k => sub1
!ERROR: Type bound generic procedure 'x' may not have the same name as a non-generic symbol inherited from an ancestor type
- generic :: x => sub
+ generic :: x => sub1
!ERROR: Type bound generic procedure 'tbp' may not have the same name as a non-generic symbol inherited from an ancestor type
- generic :: tbp => sub
- generic :: gen => sub ! ok
+ generic :: tbp => sub1
+ generic :: gen1 => sub1 ! ok
+ !ERROR: Generic 'gen2' may not have specific procedures 'tbp' and 'sub2' as their interfaces are not distinguishable
+ generic :: gen2 => sub2
end type
contains
- subroutine sub
+ subroutine sub1
+ end
+ subroutine sub2
end
end
More information about the flang-commits
mailing list