[flang] Better error handling and testing of generics with homonymous specifics or derived types

Fortran allows a generic procedure interface to have the same name as a derived
type in the same scope or the same name as one of its specific procedures.
(It can't have both since a derived type and specific procedure can't have the
same name in a scope.)

Some popular compilers allow generic interfaces with distinct accessible homonymous
specific procedures to be merged by USE association.  Thsi compiler does not,
and for good reason: it leads to ambiguity in cases where a procedure name appears
outside a reference, such as in a PROCEDURE declaration statement as the procedure's
interface, the target of a procedure pointer assignment statement, or as an
actual argument.

This patch cleans up the code that handles these cases, improves some error
messages, and adds more tests.

Resolves https://github.com/llvm/llvm-project/issues/60228.

Differential Revision: https://reviews.llvm.org/D150915
This commit is contained in:
Peter Klausler 2023-05-18 10:32:14 -07:00
parent a8654b4457
commit 3d05ab6d3e
No known key found for this signature in database
4 changed files with 190 additions and 52 deletions

View File

@ -630,7 +630,15 @@ public:
// report the error elsewhere
return *symbol;
}
SayAlreadyDeclared(name, *symbol);
Symbol &errSym{*symbol};
if (auto *d{symbol->detailsIf<GenericDetails>()}) {
if (d->specific()) {
errSym = *d->specific();
} else if (d->derivedType()) {
errSym = *d->derivedType();
}
}
SayAlreadyDeclared(name, errSym);
}
// replace the old symbol with a new one with correct details
EraseSymbol(*symbol);
@ -2899,9 +2907,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
auto checkAmbiguousDerivedType{[this, location, localName](
const Symbol *t1, const Symbol *t2) {
if (!t1 || !t2) {
return true;
} else {
if (t1 && t2) {
t1 = &t1->GetUltimate();
t2 = &t2->GetUltimate();
if (&t1 != &t2) {
@ -2912,6 +2918,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
return false;
}
}
return true;
}};
auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
@ -2919,29 +2926,18 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
auto combine{false};
if (localGeneric) {
if (useGeneric) {
if (!checkAmbiguousDerivedType(
localGeneric->derivedType(), useGeneric->derivedType())) {
return;
}
combine = true;
combine = checkAmbiguousDerivedType(
localGeneric->derivedType(), useGeneric->derivedType());
} else if (useUltimate.has<DerivedTypeDetails>()) {
if (checkAmbiguousDerivedType(
&useUltimate, localGeneric->derivedType())) {
combine = true;
} else {
return;
}
combine =
checkAmbiguousDerivedType(&useUltimate, localGeneric->derivedType());
} else if (&useUltimate == &BypassGeneric(localUltimate).GetUltimate()) {
return; // nothing to do; used subprogram is local's specific
}
} else if (useGeneric) {
if (localUltimate.has<DerivedTypeDetails>()) {
if (checkAmbiguousDerivedType(
&localUltimate, useGeneric->derivedType())) {
combine = true;
} else {
return;
}
combine =
checkAmbiguousDerivedType(&localUltimate, useGeneric->derivedType());
} else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate()) {
// Local is the specific of the used generic; replace it.
EraseSymbol(localSymbol);
@ -2989,14 +2985,19 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
// cases are handled above without needing to make a local copy of the
// generic.)
std::optional<parser::MessageFixedText> msg;
if (localGeneric) {
if (localSymbol.has<UseDetails>()) {
// Create a local copy of a previously use-associated generic so that
// it can be locally extended without corrupting the original.
GenericDetails generic;
generic.CopyFrom(*localGeneric);
if (localGeneric->specific()) {
generic.set_specific(*localGeneric->specific());
if (Symbol * spec{localGeneric->specific()};
spec && !spec->attrs().test(Attr::PRIVATE)) {
generic.set_specific(*spec);
} else if (Symbol * dt{generic.derivedType()};
dt && dt->attrs().test(Attr::PRIVATE)) {
generic.clear_derivedType();
}
EraseSymbol(localSymbol);
Symbol &newSymbol{MakeSymbol(
@ -3012,43 +3013,67 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
localSymbol.flags() = useSymbol.flags();
AddGenericUse(*localGeneric, localName, useUltimate);
localGeneric->CopyFrom(*useGeneric);
if (useGeneric->specific()) {
if (!localGeneric->specific()) {
localGeneric->set_specific(
*const_cast<Symbol *>(useGeneric->specific()));
if (const Symbol * useSpec{useGeneric->specific()};
useSpec && !useSpec->attrs().test(Attr::PRIVATE)) {
if (localGeneric->derivedType()) {
msg =
"Cannot use-associate generic interface '%s' with specific procedure of the same name when another such interface and derived type are in scope"_err_en_US;
} else if (!localGeneric->specific()) {
localGeneric->set_specific(*const_cast<Symbol *>(useSpec));
} else if (&localGeneric->specific()->GetUltimate() !=
&useGeneric->specific()->GetUltimate()) {
Say(location,
"Cannot use-associate generic interface '%s' with specific procedure of the same name when another such generic is in scope"_err_en_US,
localName)
.Attach(
localSymbol.name(), "Previous USE of '%s'"_en_US, localName);
&useSpec->GetUltimate()) {
msg =
"Cannot use-associate generic interface '%s' with specific procedure of the same name when another such interface and procedure are in scope"_err_en_US;
}
} else if (const Symbol * useDT{useGeneric->derivedType()};
useDT && !useDT->attrs().test(Attr::PRIVATE)) {
if (localGeneric->specific()) {
msg =
"Cannot use-associate generic interface '%s' with derived type of the same name when another such interface and procedure are in scope"_err_en_US;
} else if (!localGeneric->derivedType()) {
localGeneric->set_derivedType(*const_cast<Symbol *>(useDT));
} else if (&localGeneric->derivedType()->GetUltimate() !=
&useDT->GetUltimate()) {
msg =
"Cannot use-associate generic interface '%s' with derived type of the same name when another such interface and derived type are in scope"_err_en_US;
}
}
} else {
CHECK(useUltimate.has<DerivedTypeDetails>());
localGeneric->set_derivedType(
AddGenericUse(*localGeneric, localName, useUltimate));
if (!localGeneric->derivedType()) {
localGeneric->set_derivedType(
AddGenericUse(*localGeneric, localName, useUltimate));
} else if (&localGeneric->derivedType()->GetUltimate() != &useUltimate) {
msg =
"Cannot use-associate derived type '%s' when a generic interface and derived type of the same name are in scope"_err_en_US;
}
}
} else {
CHECK(useGeneric && localUltimate.has<DerivedTypeDetails>());
CHECK(localSymbol.has<UseDetails>());
// Create a local copy of the use-associated generic, then extend it
// with the local derived type.
GenericDetails generic;
generic.CopyFrom(*useGeneric);
if (useGeneric->specific()) {
generic.set_specific(*const_cast<Symbol *>(useGeneric->specific()));
if (!useGeneric->derivedType() ||
&useGeneric->derivedType()->GetUltimate() == &localUltimate) {
GenericDetails generic;
generic.CopyFrom(*useGeneric);
EraseSymbol(localSymbol);
Symbol &newSymbol{MakeSymbol(localName,
useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
std::move(generic))};
newSymbol.flags() = useUltimate.flags();
auto &newUseGeneric{newSymbol.get<GenericDetails>()};
AddGenericUse(newUseGeneric, localName, useUltimate);
newUseGeneric.AddUse(localSymbol);
newUseGeneric.set_derivedType(localSymbol);
} else if (useGeneric->derivedType()) {
msg =
"Cannot use-associate generic interface '%s' with derived type of the same name when another such derived type is in scope"_err_en_US;
}
EraseSymbol(localSymbol);
Symbol &newSymbol{MakeSymbol(localName,
useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
std::move(generic))};
newSymbol.flags() = useUltimate.flags();
auto &newUseGeneric{newSymbol.get<GenericDetails>()};
AddGenericUse(newUseGeneric, localName, useUltimate);
newUseGeneric.AddUse(localSymbol);
newUseGeneric.set_derivedType(localSymbol);
}
if (msg) {
Say(location, std::move(*msg), localName)
.Attach(localSymbol.name(), "Previous USE of '%s'"_en_US, localName);
}
}

View File

@ -190,13 +190,13 @@ contains
end module
subroutine s9a
use m9a
!ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such generic is in scope
!ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such interface and procedure are in scope
use m9b
end
subroutine s9b
!ERROR: USE-associated generic 'g' may not have specific procedures 'g' and 'g' as their interfaces are not distinguishable
use m9a
!ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such generic is in scope
!ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such interface and procedure are in scope
use m9c
end

View File

@ -55,11 +55,11 @@ end
module m4b
type :: foo
end type
!ERROR: 'foo' is already declared in this scoping unit
interface foo
procedure :: foo
end interface foo
contains
!ERROR: 'foo' is already declared in this scoping unit
function foo(x)
end
end
@ -125,12 +125,12 @@ end module m8
module m9
type f9
end type f9
!ERROR: 'f9' is already declared in this scoping unit
interface f9
real function f9()
end function f9
end interface f9
contains
!ERROR: 'f9' is already declared in this scoping unit
function f9(x)
end function f9
end module m9
@ -208,3 +208,69 @@ module m15
integer(4) :: x
end subroutine gen2
end module m15
module m15a
interface foo
module procedure foo
end interface
contains
function foo()
end
end
module m15b
interface foo
module procedure foo
end interface
contains
function foo(x)
end
end
subroutine test15
use m15a
!ERROR: Cannot use-associate generic interface 'foo' with specific procedure of the same name when another such interface and procedure are in scope
use m15b
end
module m16a
type foo
integer j
end type
interface foo
module procedure bar
end interface
contains
function bar(j)
end
end
module m16b
type foo
integer j, k
end type
interface foo
module procedure bar
end interface
contains
function bar(x,y)
end
end
subroutine test16
use m16a
!ERROR: Generic interface 'foo' has ambiguous derived types from modules 'm16a' and 'm16b'
use m16b
end
subroutine test17
use m15a
!ERROR: Cannot use-associate generic interface 'foo' with derived type of the same name when another such interface and procedure are in scope
use m16a
end
subroutine test18
use m16a
!ERROR: Cannot use-associate generic interface 'foo' with specific procedure of the same name when another such interface and derived type are in scope
use m15a
end

View File

@ -0,0 +1,47 @@
! RUN: %python %S/test_symbols.py %s %flang_fc1
!DEF: /m1a Module
module m1a
!DEF: /m1a/foo PUBLIC DerivedType
type :: foo
!DEF: /m1a/foo/j ObjectEntity INTEGER(4)
integer :: j
end type
end module
!DEF: /m1b Module
module m1b
!DEF: /m1b/foo PUBLIC (Function) Generic
interface foo
!DEF: /m1b/bar PUBLIC (Function) Subprogram REAL(4)
module procedure :: bar
end interface
contains
!REF: /m1b/bar
function bar()
end function
end module
!DEF: /test1a (Subroutine) Subprogram
subroutine test1a
!REF: /m1a
use :: m1a
!REF: /m1b
use :: m1b
!DEF: /test1a/foo (Function) Generic
!DEF: /test1a/x ObjectEntity TYPE(foo)
type(foo) :: x
!DEF: /test1a/foo Use
!REF: /m1b/bar
print *, foo(1), foo()
end subroutine
!DEF: /test1b (Subroutine) Subprogram
subroutine test1b
!REF: /m1b
use :: m1b
!REF: /m1a
use :: m1a
!DEF: /test1b/foo (Function) Generic
!DEF: /test1b/x ObjectEntity TYPE(foo)
type(foo) :: x
!DEF: /test1b/foo Use
!REF: /m1b/bar
print *, foo(1), foo()
end subroutine