Index: flang/include/flang/Semantics/scope.h =================================================================== --- flang/include/flang/Semantics/scope.h +++ flang/include/flang/Semantics/scope.h @@ -117,6 +117,7 @@ const Scope *GetDerivedTypeParent() const; const Scope &GetDerivedTypeBase() const; inline std::optional GetName() const; + // Returns true if this scope contains, or is, another scope. bool Contains(const Scope &) const; /// Make a scope nested in this one Scope &MakeScope(Kind kind, Symbol *symbol = nullptr); Index: flang/include/flang/Semantics/tools.h =================================================================== --- flang/include/flang/Semantics/tools.h +++ flang/include/flang/Semantics/tools.h @@ -84,8 +84,13 @@ bool IsGenericDefinedOp(const Symbol &); bool IsDefinedOperator(SourceName); std::string MakeOpName(SourceName); + +// Returns true if maybeAncestor exists and is a proper ancestor of a +// descendent scope (or symbol owner). Will be false, unlike Scope::Contains(), +// if maybeAncestor *is* the descendent. bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent); bool DoesScopeContain(const Scope *, const Symbol &); + bool IsUseAssociated(const Symbol &, const Scope &); bool IsHostAssociated(const Symbol &, const Scope &); bool IsHostAssociatedIntoSubprogram(const Symbol &, const Scope &); @@ -181,8 +186,9 @@ bool IsAssumedType(const Symbol &); bool IsPolymorphic(const Symbol &); bool IsPolymorphicAllocatable(const Symbol &); -// Return an error if component symbol is not accessible from scope (7.5.4.8(2)) -std::optional CheckAccessibleComponent( + +// Return an error if a symbol is not accessible from a scope +std::optional CheckAccessibleSymbol( const semantics::Scope &, const Symbol &); // Analysis of image control statements Index: flang/lib/Semantics/expression.cpp =================================================================== --- flang/lib/Semantics/expression.cpp +++ flang/lib/Semantics/expression.cpp @@ -155,8 +155,10 @@ // Find and return a user-defined operator or report an error. // The provided message is used if there is no such operator. - MaybeExpr TryDefinedOp(const char *, parser::MessageFixedText, - const Symbol **definedOpSymbolPtr = nullptr, bool isUserOp = false); + // If a definedOpSymbolPtr is provided, the caller must check + // for its accessibility. + MaybeExpr TryDefinedOp( + const char *, parser::MessageFixedText, bool isUserOp = false); template MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText msg) { return TryDefinedOp( @@ -174,8 +176,8 @@ std::optional AnalyzeExpr(const parser::Expr &); MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &); bool AreConformable() const; - const Symbol *FindBoundOp( - parser::CharBlock, int passIndex, const Symbol *&definedOp); + const Symbol *FindBoundOp(parser::CharBlock, int passIndex, + const Symbol *&generic, bool isSubroutine); void AddAssignmentConversion( const DynamicType &lhsType, const DynamicType &rhsType); bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs); @@ -1777,10 +1779,9 @@ } } if (symbol) { - if (const auto *currScope{context_.globalScope().FindScope(source)}) { - if (auto msg{CheckAccessibleComponent(*currScope, *symbol)}) { - Say(source, *msg); - } + const semantics::Scope &innermost{context_.FindScope(expr.source)}; + if (auto msg{CheckAccessibleSymbol(innermost, *symbol)}) { + Say(expr.source, std::move(*msg)); } if (checkConflicts) { auto componentIter{ @@ -1808,7 +1809,6 @@ } unavailable.insert(symbol->name()); if (value) { - const auto &innermost{context_.FindScope(expr.source)}; if (symbol->has()) { CHECK(IsPointer(*symbol)); } else if (symbol->has()) { @@ -2801,7 +2801,7 @@ ArgumentAnalyzer analyzer{*this, name.source}; analyzer.Analyze(std::get<1>(x.t)); return analyzer.TryDefinedOp(name.source.ToString().c_str(), - "No operator %s defined for %s"_err_en_US, nullptr, true); + "No operator %s defined for %s"_err_en_US, true); } // Binary (dyadic) operations @@ -2998,7 +2998,7 @@ analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<2>(x.t)); return analyzer.TryDefinedOp(name.source.ToString().c_str(), - "No operator %s defined for %s and %s"_err_en_US, nullptr, true); + "No operator %s defined for %s and %s"_err_en_US, true); } // Returns true if a parsed function reference should be converted @@ -3561,63 +3561,100 @@ return true; } -MaybeExpr ArgumentAnalyzer::TryDefinedOp(const char *opr, - parser::MessageFixedText error, const Symbol **definedOpSymbolPtr, - bool isUserOp) { +MaybeExpr ArgumentAnalyzer::TryDefinedOp( + const char *opr, parser::MessageFixedText error, bool isUserOp) { if (AnyUntypedOrMissingOperand()) { context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); return std::nullopt; } - const Symbol *localDefinedOpSymbolPtr{nullptr}; - if (!definedOpSymbolPtr) { - definedOpSymbolPtr = &localDefinedOpSymbolPtr; - } + MaybeExpr result; + bool anyPossibilities{false}; + std::optional inaccessible; + std::vector hit; + std::string oprNameString{ + isUserOp ? std::string{opr} : "operator("s + opr + ')'}; + parser::CharBlock oprName{oprNameString}; { auto restorer{context_.GetContextualMessages().DiscardMessages()}; - std::string oprNameString{ - isUserOp ? std::string{opr} : "operator("s + opr + ')'}; - parser::CharBlock oprName{oprNameString}; const auto &scope{context_.context().FindScope(source_)}; if (Symbol * symbol{scope.FindSymbol(oprName)}) { - *definedOpSymbolPtr = symbol; + anyPossibilities = true; parser::Name name{symbol->name(), symbol}; - if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) { - return result; + result = context_.AnalyzeDefinedOp(name, GetActuals()); + if (result) { + inaccessible = CheckAccessibleSymbol(scope, *symbol); + if (inaccessible) { + result.reset(); + } else { + hit.push_back(symbol); + } } } for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) { - if (const Symbol * - symbol{FindBoundOp(oprName, passIndex, *definedOpSymbolPtr)}) { - if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) { - return result; + const Symbol *generic{nullptr}; + if (const Symbol *binding{ + FindBoundOp(oprName, passIndex, generic, false)}) { + anyPossibilities = true; + if (MaybeExpr thisResult{TryBoundOp(*binding, passIndex)}) { + if (auto thisInaccessible{ + CheckAccessibleSymbol(scope, DEREF(generic))}) { + inaccessible = thisInaccessible; + } else { + result = std::move(thisResult); + hit.push_back(binding); + } } } } } - if (*definedOpSymbolPtr) { - SayNoMatch(ToUpperCase((*definedOpSymbolPtr)->name().ToString())); - } else if (actuals_.size() == 1 || AreConformable()) { - if (CheckForNullPointer()) { - context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); + if (result) { + if (hit.size() > 1) { + if (auto *msg{context_.Say( + "%zd matching accessible generic interfaces for %s were found"_err_en_US, + hit.size(), ToUpperCase(opr))}) { + for (const Symbol *symbol : hit) { + AttachDeclaration(*msg, *symbol); + } + } } - } else { + } else if (inaccessible) { + context_.Say(source_, std::move(*inaccessible)); + } else if (anyPossibilities) { + SayNoMatch(ToUpperCase(oprNameString), false); + } else if (actuals_.size() == 2 && !AreConformable()) { context_.Say( "Operands of %s are not conformable; have rank %d and rank %d"_err_en_US, ToUpperCase(opr), actuals_[0]->Rank(), actuals_[1]->Rank()); + } else if (CheckForNullPointer()) { + context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); } - return std::nullopt; + return result; } MaybeExpr ArgumentAnalyzer::TryDefinedOp( std::vector oprs, parser::MessageFixedText error) { - const Symbol *definedOpSymbolPtr{nullptr}; - for (std::size_t i{1}; i < oprs.size(); ++i) { + if (oprs.size() == 1) { + return TryDefinedOp(oprs[0], error); + } + MaybeExpr result; + std::vector hit; + { auto restorer{context_.GetContextualMessages().DiscardMessages()}; - if (auto result{TryDefinedOp(oprs[i], error, &definedOpSymbolPtr)}) { - return result; + for (std::size_t i{0}; i < oprs.size(); ++i) { + if (MaybeExpr thisResult{TryDefinedOp(oprs[i], error)}) { + result = std::move(thisResult); + hit.push_back(oprs[i]); + } } } - return TryDefinedOp(oprs[0], error, &definedOpSymbolPtr); + if (hit.empty()) { // for the error + result = TryDefinedOp(oprs[0], error); + } else if (hit.size() > 1) { + context_.Say( + "Matching accessible definitions were found with %zd variant spellings of the generic operator ('%s', '%s')"_err_en_US, + hit.size(), ToUpperCase(hit[0]), ToUpperCase(hit[1])); + } + return result; } MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) { @@ -3694,30 +3731,34 @@ } std::optional ArgumentAnalyzer::GetDefinedAssignmentProc() { - auto restorer{context_.GetContextualMessages().DiscardMessages()}; + const Symbol *proc{nullptr}; + int passedObjectIndex{-1}; std::string oprNameString{"assignment(=)"}; parser::CharBlock oprName{oprNameString}; - const Symbol *proc{nullptr}; const auto &scope{context_.context().FindScope(source_)}; - if (const Symbol * symbol{scope.FindSymbol(oprName)}) { - ExpressionAnalyzer::AdjustActuals noAdjustment; - auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true)}; - if (pair.first) { - proc = pair.first; - } else { - context_.EmitGenericResolutionError(*symbol, pair.second); - } - } - int passedObjectIndex{-1}; - const Symbol *definedOpSymbol{nullptr}; - for (std::size_t i{0}; i < actuals_.size(); ++i) { - if (const Symbol * specific{FindBoundOp(oprName, i, definedOpSymbol)}) { - if (const Symbol * - resolution{GetBindingResolution(GetType(i), *specific)}) { - proc = resolution; + // If multiple resolutions were possible, they will have been already + // diagnosed. + { + auto restorer{context_.GetContextualMessages().DiscardMessages()}; + if (const Symbol *symbol{scope.FindSymbol(oprName)}) { + ExpressionAnalyzer::AdjustActuals noAdjustment; + auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true)}; + if (pair.first) { + proc = pair.first; } else { - proc = specific; - passedObjectIndex = i; + context_.EmitGenericResolutionError(*symbol, pair.second); + } + } + for (std::size_t i{0}; i < actuals_.size(); ++i) { + const Symbol *generic{nullptr}; + if (const Symbol *specific{FindBoundOp(oprName, i, generic, true)}) { + if (const Symbol *resolution{ + GetBindingResolution(GetType(i), *specific)}) { + proc = resolution; + } else { + proc = specific; + passedObjectIndex = i; + } } } } @@ -3794,24 +3835,24 @@ } // Look for a type-bound operator in the type of arg number passIndex. -const Symbol *ArgumentAnalyzer::FindBoundOp( - parser::CharBlock oprName, int passIndex, const Symbol *&definedOp) { +const Symbol *ArgumentAnalyzer::FindBoundOp(parser::CharBlock oprName, + int passIndex, const Symbol *&generic, bool isSubroutine) { const auto *type{GetDerivedTypeSpec(GetType(passIndex))}; if (!type || !type->scope()) { return nullptr; } - const Symbol *symbol{type->scope()->FindComponent(oprName)}; - if (!symbol) { + generic = type->scope()->FindComponent(oprName); + if (!generic) { return nullptr; } - definedOp = symbol; ExpressionAnalyzer::AdjustActuals adjustment{ [&](const Symbol &proc, ActualArguments &) { return passIndex == GetPassIndex(proc); }}; - auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment, false)}; + auto pair{ + context_.ResolveGeneric(*generic, actuals_, adjustment, isSubroutine)}; if (!pair.first) { - context_.EmitGenericResolutionError(*symbol, pair.second); + context_.EmitGenericResolutionError(*generic, pair.second); } return pair.first; } Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -5974,7 +5974,7 @@ } else if (extends) { msg = "Type cannot be extended as it has a component named" " '%s'"_err_en_US; - } else if (CheckAccessibleComponent(currScope(), *prev)) { + } else if (CheckAccessibleSymbol(currScope(), *prev)) { // inaccessible component -- redeclaration is ok msg = "Component '%s' is inaccessibly declared in or as a " "parent of this derived type"_warn_en_US; @@ -6841,8 +6841,7 @@ derived->Instantiate(currScope()); // in case of forward referenced type if (const Scope * scope{derived->scope()}) { if (Resolve(component, scope->FindComponent(component.source))) { - if (auto msg{ - CheckAccessibleComponent(currScope(), *component.symbol)}) { + if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) { context().Say(component.source, *msg); } return &component; Index: flang/lib/Semantics/tools.cpp =================================================================== --- flang/lib/Semantics/tools.cpp +++ flang/lib/Semantics/tools.cpp @@ -961,9 +961,8 @@ return IsAllocatable(symbol) && IsPolymorphic(symbol); } -std::optional CheckAccessibleComponent( +std::optional CheckAccessibleSymbol( const Scope &scope, const Symbol &symbol) { - CHECK(symbol.owner().IsDerivedType()); // symbol must be a component if (symbol.attrs().test(Attr::PRIVATE)) { if (FindModuleFileContaining(scope)) { // Don't enforce component accessibility checks in module files; @@ -973,7 +972,7 @@ moduleScope{FindModuleContaining(symbol.owner())}) { if (!moduleScope->Contains(scope)) { return parser::MessageFormattedText{ - "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US, + "PRIVATE name '%s' is only accessible within module '%s'"_err_en_US, symbol.name(), moduleScope->GetName().value()}; } } Index: flang/test/Semantics/resolve34.f90 =================================================================== --- flang/test/Semantics/resolve34.f90 +++ flang/test/Semantics/resolve34.f90 @@ -91,9 +91,9 @@ type(t2) :: x integer :: j j = x%i2 - !ERROR: PRIVATE component 'i3' is only accessible within module 'm7' + !ERROR: PRIVATE name 'i3' is only accessible within module 'm7' j = x%i3 - !ERROR: PRIVATE component 't1' is only accessible within module 'm7' + !ERROR: PRIVATE name 't1' is only accessible within module 'm7' j = x%t1%i1 end @@ -117,11 +117,11 @@ subroutine s8 use m8 type(t) :: x - !ERROR: PRIVATE component 'i2' is only accessible within module 'm8' + !ERROR: PRIVATE name 'i2' is only accessible within module 'm8' x = t(2, 5) - !ERROR: PRIVATE component 'i2' is only accessible within module 'm8' + !ERROR: PRIVATE name 'i2' is only accessible within module 'm8' x = t(i1=2, i2=5) - !ERROR: PRIVATE component 'i2' is only accessible within module 'm8' + !ERROR: PRIVATE name 'i2' is only accessible within module 'm8' a = [y%i2] end @@ -143,3 +143,24 @@ x = t(i1=2, i2=5) !OK end end + +module m10 + type t + integer n + contains + procedure :: f + generic, private :: operator(+) => f + end type + contains + type(t) function f(x,y) + class(t), intent(in) :: x, y + f = t(x%n + y%n) + end function +end module +subroutine s10 + use m10 + type(t) x + x = t(1) + !ERROR: PRIVATE name 'operator(+)' is only accessible within module 'm10' + x = x + x +end subroutine Index: flang/test/Semantics/resolve63.f90 =================================================================== --- flang/test/Semantics/resolve63.f90 +++ flang/test/Semantics/resolve63.f90 @@ -58,15 +58,15 @@ l = z'fe' == r !OK l = cVar == z'fe' !OK l = z'fe' == cVar !OK - !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types CHARACTER(KIND=1) and INTEGER(4) + !ERROR: Operands of .EQ. must have comparable types; have CHARACTER(KIND=1) and INTEGER(4) l = charVar == z'fe' - !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types INTEGER(4) and CHARACTER(KIND=1) + !ERROR: Operands of .EQ. must have comparable types; have INTEGER(4) and CHARACTER(KIND=1) l = z'fe' == charVar - !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types LOGICAL(4) and INTEGER(4) - l = l == z'fe' !OK - !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types INTEGER(4) and LOGICAL(4) - l = z'fe' == l !OK - !ERROR: No intrinsic or user-defined OPERATOR(==) matches operand types TYPE(t) and REAL(4) + !ERROR: Operands of .EQ. must have comparable types; have LOGICAL(4) and INTEGER(4) + l = l == z'fe' + !ERROR: Operands of .EQ. must have comparable types; have INTEGER(4) and LOGICAL(4) + l = z'fe' == l + !ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4) l = x == r lVar = z'a' == b'1010' !OK @@ -265,9 +265,9 @@ i = x + y i = x + i i = y + i - !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types CLASS(t2) and CLASS(t1) + !ERROR: Operands of + must be numeric; have CLASS(t2) and CLASS(t1) i = y + x - !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types INTEGER(4) and CLASS(t1) + !ERROR: Operands of + must be numeric; have INTEGER(4) and CLASS(t1) i = i + x end end @@ -307,9 +307,9 @@ j = null() - null(mold=x1) j = null(mold=x1) - null() j = null() - null() - !ERROR: No intrinsic or user-defined OPERATOR(/) matches operand types untyped and TYPE(t1) + !ERROR: A NULL() pointer is not allowed as an operand here j = null() / null(mold=x1) - !ERROR: No intrinsic or user-defined OPERATOR(/) matches operand types TYPE(t1) and untyped + !ERROR: A NULL() pointer is not allowed as an operand here j = null(mold=x1) / null() !ERROR: A NULL() pointer is not allowed as an operand here j = null() / null() Index: flang/test/Semantics/resolve64.f90 =================================================================== --- flang/test/Semantics/resolve64.f90 +++ flang/test/Semantics/resolve64.f90 @@ -37,9 +37,9 @@ subroutine s1(x, y, z) logical :: x complex :: y, z - !ERROR: No intrinsic or user-defined OPERATOR(.A.) matches operand types COMPLEX(4) and COMPLEX(4) + !ERROR: Operands of .AND. must be LOGICAL; have COMPLEX(4) and COMPLEX(4) x = y .and. z - !ERROR: No intrinsic or user-defined OPERATOR(.A.) matches operand types COMPLEX(4) and COMPLEX(4) + !ERROR: Operands of .AND. must be LOGICAL; have COMPLEX(4) and COMPLEX(4) x = y .a. z end end