[flang] Refine checking of type-bound generics (#129292)
I merged a patch yesterday (https://github.com/llvm/llvm-project/pull/128980) that strengthened error detection of indistinguishable specific procedures in a type-bound generic procedure, and broke a couple of tests. Refine the check so that it doesn't flag valid cases of overridden bindings, and add a thorough test with all of the boundary cases that I can think of.
This commit is contained in:
@@ -3998,26 +3998,33 @@ 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
|
||||
const auto &[ultimate2, procInfo2]{*iter2};
|
||||
if (&*ultimate == &*ultimate2) {
|
||||
continue; // ok, actually the same procedure/binding
|
||||
} else if (const auto *binding1{
|
||||
ultimate->detailsIf<ProcBindingDetails>()}) {
|
||||
if (const auto *binding2{
|
||||
iter2->first->detailsIf<ProcBindingDetails>()}) {
|
||||
ultimate2->detailsIf<ProcBindingDetails>()}) {
|
||||
if (&binding1->symbol().GetUltimate() ==
|
||||
&binding2->symbol().GetUltimate()) {
|
||||
continue; // ok, bindings resolve identically
|
||||
continue; // ok, (NOPASS) bindings resolve identically
|
||||
} else if (ultimate->name() == ultimate2->name()) {
|
||||
continue; // override, possibly of DEFERRED
|
||||
}
|
||||
}
|
||||
} else if (ultimate->has<ProcBindingDetails>() &&
|
||||
ultimate2->has<ProcBindingDetails>() &&
|
||||
ultimate->name() == ultimate2->name()) {
|
||||
continue; // override, possibly of DEFERRED
|
||||
}
|
||||
auto distinguishable{kind.IsName()
|
||||
? evaluate::characteristics::Distinguishable
|
||||
: evaluate::characteristics::DistinguishableOpOrAssign};
|
||||
std::optional<bool> distinct{distinguishable(
|
||||
context_.languageFeatures(), proc, iter2->second.procedure)};
|
||||
context_.languageFeatures(), proc, procInfo2.procedure)};
|
||||
if (!distinct.value_or(false)) {
|
||||
SayNotDistinguishable(GetTopLevelUnitContaining(scope), name, kind,
|
||||
*ultimate, *iter2->first, distinct.has_value());
|
||||
*ultimate, *ultimate2, distinct.has_value());
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
96
flang/test/Semantics/generic13.f90
Normal file
96
flang/test/Semantics/generic13.f90
Normal file
@@ -0,0 +1,96 @@
|
||||
! RUN: %python %S/test_errors.py %s %flang_fc1
|
||||
module m1
|
||||
type, abstract :: ta1
|
||||
contains
|
||||
procedure(ta1p1), deferred :: ta1p1
|
||||
generic :: gen => ta1p1
|
||||
end type
|
||||
abstract interface
|
||||
subroutine ta1p1(x)
|
||||
import ta1
|
||||
class(ta1), intent(in) :: x
|
||||
end
|
||||
end interface
|
||||
type :: tb1
|
||||
contains
|
||||
procedure tb1p1
|
||||
generic :: gen => tb1p1
|
||||
end type
|
||||
type :: tc1
|
||||
contains
|
||||
procedure tc1p1
|
||||
generic, private :: gen => tc1p1
|
||||
end type
|
||||
type :: td1
|
||||
contains
|
||||
procedure, nopass :: td1p1
|
||||
generic :: gen => td1p1
|
||||
end type
|
||||
contains
|
||||
subroutine tb1p1(x)
|
||||
class(tb1), intent(in) :: x
|
||||
end
|
||||
subroutine tb1p2(x)
|
||||
class(tb1), intent(in) :: x
|
||||
end
|
||||
subroutine tc1p1(x)
|
||||
class(tc1), intent(in) :: x
|
||||
end
|
||||
subroutine td1p1
|
||||
end
|
||||
end
|
||||
|
||||
module m2
|
||||
use m1
|
||||
type, extends(ta1) :: ta2a
|
||||
contains
|
||||
procedure :: ta1p1 => ta2ap1 ! ok
|
||||
end type
|
||||
type, extends(ta1) :: ta2b
|
||||
contains
|
||||
procedure :: ta1p1 => ta2bp1
|
||||
generic :: gen => ta1p1 ! ok, overidden deferred
|
||||
end type
|
||||
type, extends(tb1) :: tb2a
|
||||
contains
|
||||
generic :: gen => tb1p1 ! ok, same binding
|
||||
end type
|
||||
type, extends(tb1) :: tb2b
|
||||
contains
|
||||
procedure :: tb1p1 => tb2bp2
|
||||
generic :: gen => tb1p1 ! ok, overridden
|
||||
end type
|
||||
type, extends(tb1) :: tb2c
|
||||
contains
|
||||
procedure tb2cp1
|
||||
!ERROR: Generic 'gen' may not have specific procedures 'tb1p1' and 'tb2cp1' as their interfaces are not distinguishable
|
||||
generic :: gen => tb2cp1
|
||||
end type
|
||||
type, extends(tc1) :: tc2
|
||||
contains
|
||||
procedure tc2p1
|
||||
!ERROR: 'gen' does not have the same accessibility as its previous declaration
|
||||
generic :: gen => tc2p1
|
||||
end type
|
||||
type, extends(td1) :: td2
|
||||
contains
|
||||
procedure, nopass :: td2p1 => td1p1
|
||||
generic :: gen => td2p1 ! ok, same procedure
|
||||
end type
|
||||
contains
|
||||
subroutine ta2ap1(x)
|
||||
class(ta2a), intent(in) :: x
|
||||
end
|
||||
subroutine ta2bp1(x)
|
||||
class(ta2b), intent(in) :: x
|
||||
end
|
||||
subroutine tb2bp2(x)
|
||||
class(tb2b), intent(in) :: x
|
||||
end
|
||||
subroutine tb2cp1(x)
|
||||
class(tb2c), intent(in) :: x
|
||||
end
|
||||
subroutine tc2p1(x)
|
||||
class(tc2), intent(in) :: x
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user