diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -630,7 +630,15 @@ // report the error elsewhere return *symbol; } - SayAlreadyDeclared(name, *symbol); + Symbol &errSym{*symbol}; + if (auto *d{symbol->detailsIf()}) { + 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 @@ 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 @@ return false; } } + return true; }}; auto *localGeneric{localUltimate.detailsIf()}; @@ -2919,29 +2926,18 @@ 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()) { - 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()) { - 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 @@ // cases are handled above without needing to make a local copy of the // generic.) + std::optional msg; if (localGeneric) { if (localSymbol.has()) { // 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 @@ localSymbol.flags() = useSymbol.flags(); AddGenericUse(*localGeneric, localName, useUltimate); localGeneric->CopyFrom(*useGeneric); - if (useGeneric->specific()) { - if (!localGeneric->specific()) { - localGeneric->set_specific( - *const_cast(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(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(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()); - 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()); CHECK(localSymbol.has()); // 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(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()}; - 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()}; + 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 --- a/flang/test/Semantics/resolve17.f90 +++ b/flang/test/Semantics/resolve17.f90 @@ -190,13 +190,13 @@ 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 --- a/flang/test/Semantics/resolve18.f90 +++ b/flang/test/Semantics/resolve18.f90 @@ -55,11 +55,11 @@ 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 @@ 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 @@ 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 --- /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