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 @@ -6888,31 +6888,45 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) { auto info{GenericSpecInfo{x}}; - const SourceName &symbolName{info.symbolName()}; + SourceName symbolName{info.symbolName()}; if (IsLogicalConstant(context(), symbolName)) { Say(symbolName, "Logical constant '%s' may not be used as a defined operator"_err_en_US); return; } GenericDetails genericDetails; - if (Symbol * existing{FindInScope(symbolName)}) { - if (existing->has()) { - info.Resolve(existing); - return; // already have generic, add to it + Symbol *existing{nullptr}; + // Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)" + for (const std::string &n : GetAllNames(context(), symbolName)) { + existing = currScope().FindSymbol(n); + if (existing) { + break; } + } + if (existing) { Symbol &ultimate{existing->GetUltimate()}; - if (auto *ultimateDetails{ultimate.detailsIf()}) { - // convert a use-associated generic into a local generic - genericDetails.CopyFrom(*ultimateDetails); - AddGenericUse(genericDetails, existing->name(), - existing->get().symbol()); - } else if (ultimate.has() || + if (const auto *existingGeneric{ultimate.detailsIf()}) { + if (&ultimate.owner() != &currScope()) { + // Create a local copy of a host or use associated generic so that + // it can be locally extended without corrupting the original. + genericDetails.CopyFrom(*existingGeneric); + if (const auto *use{existing->detailsIf()}) { + AddGenericUse(genericDetails, existing->name(), use->symbol()); + EraseSymbol(*existing); + } + existing = &MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)); + } + info.Resolve(existing); + return; + } + if (ultimate.has() || ultimate.has()) { genericDetails.set_specific(ultimate); } else if (ultimate.has()) { genericDetails.set_derivedType(ultimate); } else { SayAlreadyDeclared(symbolName, *existing); + return; } EraseSymbol(*existing); } diff --git a/flang/test/Semantics/resolve110.f90 b/flang/test/Semantics/resolve110.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/resolve110.f90 @@ -0,0 +1,88 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Exercise ways to define and extend non-type-bound generics + +module m1 + type :: t1; end type + type :: t2; end type + interface operator(.eq.) + module procedure :: eq1 + end interface + generic :: operator(==) => eq2 + contains + logical function eq1(x, y) + type(t1), intent(in) :: x + type(t2), intent(in) :: y + eq1 = .true. + end function + logical function eq2(y, x) + type(t2), intent(in) :: y + type(t1), intent(in) :: x + eq2 = .true. + end function + subroutine test1 + type(t1) :: a + type(t2) :: b + if (a == b .and. b .eq. a) print *, 'ok' + end subroutine +end module + +module m2 + use m1 + type :: t3; end type + interface operator(==) + module procedure eq3 + end interface + generic :: operator(.eq.) => eq4 + contains + logical function eq3(x, y) + type(t1), intent(in) :: x + type(t3), intent(in) :: y + eq3 = .true. + end function + logical function eq4(y, x) + type(t3), intent(in) :: y + type(t1), intent(in) :: x + eq4 = .true. + end function + subroutine test2 + type(t1) :: a + type(t2) :: b + type(t3) :: c + if (a == b .and. b .eq. a .and. a == c .and. c .eq. a) print *, 'ok' + end subroutine +end module + +module m3 + use m2 + contains + logical function eq5(x, y) + type(t2), intent(in) :: x + type(t3), intent(in) :: y + eq5 = .true. + end function + logical function eq6(y, x) + type(t3), intent(in) :: y + type(t2), intent(in) :: x + eq6 = .true. + end function + subroutine test3 + interface operator(==) + module procedure :: eq5 + end interface + type(t1) :: a + type(t2) :: b + type(t3) :: c + if (a == b .and. b .eq. a .and. a == c .and. c .eq. a .and. b == c) print *, 'ok' + block + generic :: operator(.eq.) => eq6 + if (a == b .and. b .eq. a .and. a == c .and. c .eq. a .and. b == c .and. c .eq. b) print *, 'ok' + end block + contains + subroutine inner + interface operator(.eq.) + module procedure :: eq6 + end interface + if (a == b .and. b .eq. a .and. a == c .and. c .eq. a .and. b == c .and. c .eq. b) print *, 'ok' + end subroutine + end subroutine +end module