Skip to content

Commit

Permalink
[flang] Better error handling and testing of generics with homonymous…
Browse files Browse the repository at this point in the history 
… 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 #60228.

Differential Revision: https://reviews.llvm.org/D150915
  • Loading branch information
@klausler
klausler committed May 22, 2023
1 parent a8654b4 commit 3d05ab6
Show file tree
Hide file tree
Showing 4 changed files with 191 additions and 53 deletions.
123 changes: 74 additions & 49 deletions flang/lib/Semantics/resolve-names.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -630,7 +630,15 @@ class ScopeHandler : public ImplicitRulesVisitor {
// 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);
Expand Down Expand Up @@ -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) {
Expand All @@ -2912,36 +2918,26 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
return false;
}
}
return true;
}};

auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
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);
Expand Down Expand Up @@ -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(
Expand All @@ -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()));
}
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 (!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;
}
}
if (msg) {
Say(location, std::move(*msg), localName)
.Attach(localSymbol.name(), "Previous USE of '%s'"_en_US, localName);
}
}

Expand Down
4 changes: 2 additions & 2 deletions flang/test/Semantics/resolve17.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -190,13 +190,13 @@ subroutine g()
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

Expand Down
70 changes: 68 additions & 2 deletions flang/test/Semantics/resolve18.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,11 +55,11 @@ function foo(x)
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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -208,3 +208,69 @@ subroutine gen2(x)
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
47 changes: 47 additions & 0 deletions flang/test/Semantics/symbol27.f90
View file
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 3d05ab6

Please sign in to comment.