[flang-commits] [flang] 3d05ab6 - [flang] Better error handling and testing of generics with homonymous specifics or derived types
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon May 22 12:03:48 PDT 2023
Author: Peter Klausler
Date: 2023-05-22T12:03:36-07:00
New Revision: 3d05ab6d3e24e76ff53b8d7d623c436b4be5b809
URL: https://github.com/llvm/llvm-project/commit/3d05ab6d3e24e76ff53b8d7d623c436b4be5b809
DIFF: https://github.com/llvm/llvm-project/commit/3d05ab6d3e24e76ff53b8d7d623c436b4be5b809.diff
LOG: [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
Added:
flang/test/Semantics/symbol27.f90
Modified:
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/resolve17.f90
flang/test/Semantics/resolve18.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 430d1c3399fa..650166aa5557 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -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);
@@ -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()));
- }
- 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);
}
}
diff --git a/flang/test/Semantics/resolve17.f90 b/flang/test/Semantics/resolve17.f90
index 784abd4a5286..b7b58e0f0f3f 100644
--- a/flang/test/Semantics/resolve17.f90
+++ b/flang/test/Semantics/resolve17.f90
@@ -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
diff --git a/flang/test/Semantics/resolve18.f90 b/flang/test/Semantics/resolve18.f90
index edb59e9e131e..ab9813bcce10 100644
--- a/flang/test/Semantics/resolve18.f90
+++ b/flang/test/Semantics/resolve18.f90
@@ -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
@@ -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 @@ 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
diff --git a/flang/test/Semantics/symbol27.f90 b/flang/test/Semantics/symbol27.f90
new file mode 100644
index 000000000000..8ac8f73dc70b
--- /dev/null
+++ b/flang/test/Semantics/symbol27.f90
@@ -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
More information about the flang-commits
mailing list