From 82edd428f1856ff386716b4f836194252458d001 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Thu, 10 Sep 2020 07:22:52 -0700 Subject: [PATCH] [flang] Fix check for distinguishable operators/assignments Change how generic operators and assignments are checked for distinguishable procedures. Because of how they are invoked, available type-bound generics and normal generics all have to be considered together. This is different from how generic names are checked. Move common part of checking into DistinguishabilityHelper so that it can be used in both cases after the appropriate procedures have been added. Cache result of Procedure::Characterize(Symbol) in a map in CheckHelper so that we don't have to worry about passing the characterized Procedures around or the cost of recomputing them. Add MakeOpName() to construct names for defined operators and assignment for using in error messages. This eliminates the need for different messages in those cases. When the procedures for a defined operator or assignment are undistinguishable, include the type name in the error message, otherwise it may be ambiguous. Add missing check that procedures for defined operators are functions and that their dummy arguments are INTENT(IN) or VALUE. Differential Revision: https://reviews.llvm.org/D87341 --- flang/include/flang/Semantics/tools.h | 2 + flang/lib/Evaluate/tools.cpp | 4 +- flang/lib/Semantics/check-declarations.cpp | 271 ++++++++++++++++++---------- flang/lib/Semantics/resolve-names-utils.cpp | 6 - flang/lib/Semantics/resolve-names-utils.h | 2 - flang/lib/Semantics/resolve-names.cpp | 31 ++-- flang/lib/Semantics/tools.cpp | 13 ++ flang/test/Semantics/resolve11.f90 | 8 +- flang/test/Semantics/resolve13.f90 | 10 +- flang/test/Semantics/resolve15.f90 | 4 +- flang/test/Semantics/resolve25.f90 | 22 +-- flang/test/Semantics/resolve53.f90 | 17 +- flang/test/Semantics/resolve96.f90 | 62 +++++++ flang/test/Semantics/test_errors.sh | 2 +- 14 files changed, 301 insertions(+), 153 deletions(-) create mode 100644 flang/test/Semantics/resolve96.f90 diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index adc722c..58ba7bf 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -70,6 +70,8 @@ bool IsIntrinsicConcat( const evaluate::DynamicType &, int, const evaluate::DynamicType &, int); bool IsGenericDefinedOp(const Symbol &); +bool IsDefinedOperator(SourceName); +std::string MakeOpName(SourceName); bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent); bool DoesScopeContain(const Scope *, const Symbol &); bool IsUseAssociated(const Symbol &, const Scope &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 128a73a..4edf90d 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -813,8 +813,8 @@ parser::Message *AttachDeclaration( unhosted->detailsIf()}) { if (binding->symbol().name() != symbol.name()) { message.Attach(binding->symbol().name(), - "Procedure '%s' is bound to '%s'"_en_US, symbol.name(), - binding->symbol().name()); + "Procedure '%s' of type '%s' is bound to '%s'"_en_US, symbol.name(), + symbol.owner().GetName().value(), binding->symbol().name()); return &message; } unhosted = &binding->symbol(); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index df7ae6e..896af3c 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -21,17 +21,19 @@ namespace Fortran::semantics { -using evaluate::characteristics::DummyArgument; -using evaluate::characteristics::DummyDataObject; -using evaluate::characteristics::DummyProcedure; -using evaluate::characteristics::FunctionResult; -using evaluate::characteristics::Procedure; +namespace characteristics = evaluate::characteristics; +using characteristics::DummyArgument; +using characteristics::DummyDataObject; +using characteristics::DummyProcedure; +using characteristics::FunctionResult; +using characteristics::Procedure; class CheckHelper { public: explicit CheckHelper(SemanticsContext &c) : context_{c} {} CheckHelper(SemanticsContext &c, const Scope &s) : context_{c}, scope_{&s} {} + SemanticsContext &context() { return context_; } void Check() { Check(context_.globalScope()); } void Check(const ParamValue &, bool canBeAssumed); void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); } @@ -44,6 +46,7 @@ public: void Check(const Symbol &); void Check(const Scope &); void CheckInitialization(const Symbol &); + const Procedure *Characterize(const Symbol &); private: template void CheckSpecExpr(const A &x) { @@ -63,24 +66,20 @@ private: void CheckSubprogram(const Symbol &, const SubprogramDetails &); void CheckAssumedTypeEntity(const Symbol &, const ObjectEntityDetails &); void CheckDerivedType(const Symbol &, const DerivedTypeDetails &); - void CheckHostAssoc(const Symbol &, const HostAssocDetails &); void CheckGeneric(const Symbol &, const GenericDetails &); - std::optional> Characterize(const SymbolVector &); - bool CheckDefinedOperator(const SourceName &, const GenericKind &, - const Symbol &, const Procedure &); + void CheckHostAssoc(const Symbol &, const HostAssocDetails &); + bool CheckDefinedOperator( + SourceName, GenericKind, const Symbol &, const Procedure &); std::optional CheckNumberOfArgs( const GenericKind &, std::size_t); bool CheckDefinedOperatorArg( const SourceName &, const Symbol &, const Procedure &, std::size_t); bool CheckDefinedAssignment(const Symbol &, const Procedure &); bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int); - void CheckSpecificsAreDistinguishable( - const Symbol &, const GenericDetails &, const std::vector &); + void CheckSpecificsAreDistinguishable(const Symbol &, const GenericDetails &); void CheckEquivalenceSet(const EquivalenceSet &); void CheckBlockData(const Scope &); - - void SayNotDistinguishable( - const SourceName &, GenericKind, const Symbol &, const Symbol &); + void CheckGenericOps(const Scope &); bool CheckConflicting(const Symbol &, Attr, Attr); bool InPure() const { return innermostSymbol_ && IsPureProcedure(*innermostSymbol_); @@ -108,6 +107,27 @@ private: // This symbol is the one attached to the innermost enclosing scope // that has a symbol. const Symbol *innermostSymbol_{nullptr}; + // Cache of calls to Procedure::Characterize(Symbol) + std::map> characterizeCache_; +}; + +class DistinguishabilityHelper { +public: + DistinguishabilityHelper(SemanticsContext &context) : context_{context} {} + void Add(const Symbol &, GenericKind, const Symbol &, const Procedure &); + void Check(); + +private: + void SayNotDistinguishable( + const SourceName &, GenericKind, const Symbol &, const Symbol &); + + SemanticsContext &context_; + struct ProcedureInfo { + GenericKind kind; + const Symbol &symbol; + const Procedure &procedure; + }; + std::map> nameToInfo_; }; void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) { @@ -664,12 +684,13 @@ void CheckHelper::CheckProcEntity( // - C1551: NON_RECURSIVE prefix class SubprogramMatchHelper { public: - explicit SubprogramMatchHelper(SemanticsContext &context) - : context{context} {} + explicit SubprogramMatchHelper(CheckHelper &checkHelper) + : checkHelper{checkHelper} {} void Check(const Symbol &, const Symbol &); private: + SemanticsContext &context() { return checkHelper.context(); } void CheckDummyArg(const Symbol &, const Symbol &, const DummyArgument &, const DummyArgument &); void CheckDummyDataObject(const Symbol &, const Symbol &, @@ -692,7 +713,7 @@ private: return parser::ToUpperCaseLetters(DummyProcedure::EnumToString(attr)); } - SemanticsContext &context; + CheckHelper &checkHelper; }; // 15.6.2.6 para 3 - can the result of an ENTRY differ from its function? @@ -719,7 +740,7 @@ bool CheckHelper::IsResultOkToDiffer(const FunctionResult &result) { void CheckHelper::CheckSubprogram( const Symbol &symbol, const SubprogramDetails &details) { if (const Symbol * iface{FindSeparateModuleSubprogramInterface(&symbol)}) { - SubprogramMatchHelper{context_}.Check(symbol, *iface); + SubprogramMatchHelper{*this}.Check(symbol, *iface); } if (const Scope * entryScope{details.entryScope()}) { // ENTRY 15.6.2.6, esp. C1571 @@ -834,66 +855,25 @@ void CheckHelper::CheckHostAssoc( void CheckHelper::CheckGeneric( const Symbol &symbol, const GenericDetails &details) { - const SymbolVector &specifics{details.specificProcs()}; - const auto &bindingNames{details.bindingNames()}; - std::optional> procs{Characterize(specifics)}; - if (!procs) { - return; - } - bool ok{true}; - if (details.kind().IsIntrinsicOperator()) { - for (std::size_t i{0}; i < specifics.size(); ++i) { - auto restorer{messages_.SetLocation(bindingNames[i])}; - ok &= CheckDefinedOperator( - symbol.name(), details.kind(), specifics[i], (*procs)[i]); - } - } - if (details.kind().IsAssignment()) { - for (std::size_t i{0}; i < specifics.size(); ++i) { - auto restorer{messages_.SetLocation(bindingNames[i])}; - ok &= CheckDefinedAssignment(specifics[i], (*procs)[i]); - } - } - if (ok) { - CheckSpecificsAreDistinguishable(symbol, details, *procs); - } + CheckSpecificsAreDistinguishable(symbol, details); } // Check that the specifics of this generic are distinguishable from each other -void CheckHelper::CheckSpecificsAreDistinguishable(const Symbol &generic, - const GenericDetails &details, const std::vector &procs) { +void CheckHelper::CheckSpecificsAreDistinguishable( + const Symbol &generic, const GenericDetails &details) { + GenericKind kind{details.kind()}; const SymbolVector &specifics{details.specificProcs()}; std::size_t count{specifics.size()}; - if (count < 2) { + if (count < 2 || !kind.IsName()) { return; } - GenericKind kind{details.kind()}; - auto distinguishable{kind.IsAssignment() || kind.IsOperator() - ? evaluate::characteristics::DistinguishableOpOrAssign - : evaluate::characteristics::Distinguishable}; - for (std::size_t i1{0}; i1 < count - 1; ++i1) { - auto &proc1{procs[i1]}; - for (std::size_t i2{i1 + 1}; i2 < count; ++i2) { - auto &proc2{procs[i2]}; - if (!distinguishable(proc1, proc2)) { - SayNotDistinguishable( - generic.name(), kind, specifics[i1], specifics[i2]); - } + DistinguishabilityHelper helper{context_}; + for (const Symbol &specific : specifics) { + if (const Procedure * procedure{Characterize(specific)}) { + helper.Add(generic, kind, specific, *procedure); } } -} - -void CheckHelper::SayNotDistinguishable(const SourceName &name, - GenericKind kind, const Symbol &proc1, const Symbol &proc2) { - auto &&text{kind.IsDefinedOperator() - ? "Generic operator '%s' may not have specific procedures '%s'" - " and '%s' as their interfaces are not distinguishable"_err_en_US - : "Generic '%s' may not have specific procedures '%s'" - " and '%s' as their interfaces are not distinguishable"_err_en_US}; - auto &msg{ - context_.Say(name, std::move(text), name, proc1.name(), proc2.name())}; - evaluate::AttachDeclaration(msg, proc1); - evaluate::AttachDeclaration(msg, proc2); + helper.Check(); } static bool ConflictsWithIntrinsicAssignment(const Procedure &proc) { @@ -905,6 +885,9 @@ static bool ConflictsWithIntrinsicAssignment(const Procedure &proc) { static bool ConflictsWithIntrinsicOperator( const GenericKind &kind, const Procedure &proc) { + if (!kind.IsIntrinsicOperator()) { + return false; + } auto arg0{std::get(proc.dummyArguments[0].u).type}; auto type0{arg0.type()}; if (proc.dummyArguments.size() == 1) { // unary @@ -942,8 +925,11 @@ static bool ConflictsWithIntrinsicOperator( } // Check if this procedure can be used for defined operators (see 15.4.3.4.2). -bool CheckHelper::CheckDefinedOperator(const SourceName &opName, - const GenericKind &kind, const Symbol &specific, const Procedure &proc) { +bool CheckHelper::CheckDefinedOperator(SourceName opName, GenericKind kind, + const Symbol &specific, const Procedure &proc) { + if (context_.HasError(specific)) { + return false; + } std::optional msg; if (specific.attrs().test(Attr::NOPASS)) { // C774 msg = "%s procedure '%s' may not have NOPASS attribute"_err_en_US; @@ -962,8 +948,9 @@ bool CheckHelper::CheckDefinedOperator(const SourceName &opName, } else { return true; // OK } - SayWithDeclaration(specific, std::move(msg.value()), - parser::ToUpperCaseLetters(opName.ToString()), specific.name()); + SayWithDeclaration( + specific, std::move(*msg), MakeOpName(opName), specific.name()); + context_.SetError(specific); return false; } @@ -971,6 +958,9 @@ bool CheckHelper::CheckDefinedOperator(const SourceName &opName, // false and return the error message in msg. std::optional CheckHelper::CheckNumberOfArgs( const GenericKind &kind, std::size_t nargs) { + if (!kind.IsIntrinsicOperator()) { + return std::nullopt; + } std::size_t min{2}, max{2}; // allowed number of args; default is binary std::visit(common::visitors{ [&](const common::NumericOperator &x) { @@ -1035,6 +1025,9 @@ bool CheckHelper::CheckDefinedOperatorArg(const SourceName &opName, // Check if this procedure can be used for defined assignment (see 15.4.3.4.3). bool CheckHelper::CheckDefinedAssignment( const Symbol &specific, const Procedure &proc) { + if (context_.HasError(specific)) { + return false; + } std::optional msg; if (specific.attrs().test(Attr::NOPASS)) { // C774 msg = "Defined assignment procedure '%s' may not have" @@ -1054,6 +1047,7 @@ bool CheckHelper::CheckDefinedAssignment( return true; // OK } SayWithDeclaration(specific, std::move(msg.value()), specific.name()); + context_.SetError(specific); return false; } @@ -1086,6 +1080,7 @@ bool CheckHelper::CheckDefinedAssignmentArg( } if (msg) { SayWithDeclaration(symbol, std::move(*msg), symbol.name(), arg.name); + context_.SetError(symbol); return false; } return true; @@ -1102,17 +1097,14 @@ bool CheckHelper::CheckConflicting(const Symbol &symbol, Attr a1, Attr a2) { } } -std::optional> CheckHelper::Characterize( - const SymbolVector &specifics) { - std::vector result; - for (const Symbol &specific : specifics) { - auto proc{Procedure::Characterize(specific, context_.intrinsics())}; - if (!proc || context_.HasError(specific)) { - return std::nullopt; - } - result.emplace_back(*proc); - } - return result; +const Procedure *CheckHelper::Characterize(const Symbol &symbol) { + auto it{characterizeCache_.find(symbol)}; + if (it == characterizeCache_.end()) { + auto pair{characterizeCache_.emplace(SymbolRef{symbol}, + Procedure::Characterize(symbol, context_.intrinsics()))}; + it = pair.first; + } + return common::GetPtrFromOptional(it->second); } void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated, @@ -1298,10 +1290,8 @@ void CheckHelper::CheckProcBinding( ? "A NOPASS type-bound procedure may not override a passed-argument procedure"_err_en_US : "A passed-argument type-bound procedure may not override a NOPASS procedure"_err_en_US); } else { - auto bindingChars{evaluate::characteristics::Procedure::Characterize( - binding.symbol(), context_.intrinsics())}; - auto overriddenChars{evaluate::characteristics::Procedure::Characterize( - overriddenBinding->symbol(), context_.intrinsics())}; + const auto *bindingChars{Characterize(binding.symbol())}; + const auto *overriddenChars{Characterize(overriddenBinding->symbol())}; if (bindingChars && overriddenChars) { if (isNopass) { if (!bindingChars->CanOverride(*overriddenChars, std::nullopt)) { @@ -1357,6 +1347,7 @@ void CheckHelper::Check(const Scope &scope) { if (scope.kind() == Scope::Kind::BlockData) { CheckBlockData(scope); } + CheckGenericOps(scope); } void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &set) { @@ -1417,6 +1408,53 @@ void CheckHelper::CheckBlockData(const Scope &scope) { } } +// Check distinguishability of generic assignment and operators. +// For these, generics and generic bindings must be considered together. +void CheckHelper::CheckGenericOps(const Scope &scope) { + DistinguishabilityHelper helper{context_}; + auto addSpecifics{[&](const Symbol &generic) { + const auto *details{generic.GetUltimate().detailsIf()}; + if (!details) { + return; + } + GenericKind kind{details->kind()}; + if (!kind.IsAssignment() && !kind.IsOperator()) { + return; + } + const SymbolVector &specifics{details->specificProcs()}; + const std::vector &bindingNames{details->bindingNames()}; + for (std::size_t i{0}; i < specifics.size(); ++i) { + const Symbol &specific{*specifics[i]}; + if (const Procedure * proc{Characterize(specific)}) { + auto restorer{messages_.SetLocation(bindingNames[i])}; + if (kind.IsAssignment()) { + if (!CheckDefinedAssignment(specific, *proc)) { + continue; + } + } else { + if (!CheckDefinedOperator(generic.name(), kind, specific, *proc)) { + continue; + } + } + helper.Add(generic, kind, specific, *proc); + } + } + }}; + for (const auto &pair : scope) { + const Symbol &symbol{*pair.second}; + addSpecifics(symbol); + const Symbol &ultimate{symbol.GetUltimate()}; + if (ultimate.has()) { + if (const Scope * typeScope{ultimate.scope()}) { + for (const auto &pair2 : *typeScope) { + addSpecifics(*pair2.second); + } + } + } + } + helper.Check(); +} + void SubprogramMatchHelper::Check( const Symbol &symbol1, const Symbol &symbol2) { const auto details1{symbol1.get()}; @@ -1469,8 +1507,8 @@ void SubprogramMatchHelper::Check( string1, string2); } } - auto proc1{Procedure::Characterize(symbol1, context.intrinsics())}; - auto proc2{Procedure::Characterize(symbol2, context.intrinsics())}; + const Procedure *proc1{checkHelper.Characterize(symbol1)}; + const Procedure *proc2{checkHelper.Characterize(symbol2)}; if (!proc1 || !proc2) { return; } @@ -1583,7 +1621,7 @@ bool SubprogramMatchHelper::CheckSameIntent(const Symbol &symbol1, template void SubprogramMatchHelper::Say(const Symbol &symbol1, const Symbol &symbol2, parser::MessageFixedText &&text, A &&...args) { - auto &message{context.Say(symbol1.name(), std::move(text), symbol1.name(), + auto &message{context().Say(symbol1.name(), std::move(text), symbol1.name(), std::forward(args)...)}; evaluate::AttachDeclaration(message, symbol2); } @@ -1615,7 +1653,7 @@ bool SubprogramMatchHelper::CheckSameAttrs( bool SubprogramMatchHelper::ShapesAreCompatible( const DummyDataObject &obj1, const DummyDataObject &obj2) { - return evaluate::characteristics::ShapesAreCompatible( + return characteristics::ShapesAreCompatible( FoldShape(obj1.type.shape()), FoldShape(obj2.type.shape())); } @@ -1623,11 +1661,58 @@ evaluate::Shape SubprogramMatchHelper::FoldShape(const evaluate::Shape &shape) { evaluate::Shape result; for (const auto &extent : shape) { result.emplace_back( - evaluate::Fold(context.foldingContext(), common::Clone(extent))); + evaluate::Fold(context().foldingContext(), common::Clone(extent))); } return result; } +void DistinguishabilityHelper::Add(const Symbol &generic, GenericKind kind, + const Symbol &specific, const Procedure &procedure) { + if (!context_.HasError(specific)) { + nameToInfo_[generic.name()].emplace_back( + ProcedureInfo{kind, specific, procedure}); + } +} + +void DistinguishabilityHelper::Check() { + for (const auto &[name, info] : nameToInfo_) { + auto count{info.size()}; + for (std::size_t i1{0}; i1 < count - 1; ++i1) { + const auto &[kind1, symbol1, proc1] = info[i1]; + for (std::size_t i2{i1 + 1}; i2 < count; ++i2) { + const auto &[kind2, symbol2, proc2] = info[i2]; + auto distinguishable{kind1.IsName() + ? evaluate::characteristics::Distinguishable + : evaluate::characteristics::DistinguishableOpOrAssign}; + if (!distinguishable(proc1, proc2)) { + SayNotDistinguishable(name, kind1, symbol1, symbol2); + } + } + } + } +} + +void DistinguishabilityHelper::SayNotDistinguishable(const SourceName &name, + GenericKind kind, const Symbol &proc1, const Symbol &proc2) { + std::string name1{proc1.name().ToString()}; + std::string name2{proc2.name().ToString()}; + if (kind.IsOperator() || kind.IsAssignment()) { + // proc1 and proc2 may come from different scopes so qualify their names + if (proc1.owner().IsDerivedType()) { + name1 = proc1.owner().GetName()->ToString() + '%' + name1; + } + if (proc2.owner().IsDerivedType()) { + name2 = proc2.owner().GetName()->ToString() + '%' + name2; + } + } + auto &msg{context_.Say(name, + "Generic '%s' may not have specific procedures '%s' and '%s'" + " as their interfaces are not distinguishable"_err_en_US, + MakeOpName(name), name1, name2)}; + evaluate::AttachDeclaration(msg, proc1); + evaluate::AttachDeclaration(msg, proc2); +} + void CheckDeclarations(SemanticsContext &context) { CheckHelper{context}.Check(); } diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp index d6f0302..8dbd25e 100644 --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -47,12 +47,6 @@ parser::MessageFixedText WithIsFatal( msg.text().begin(), msg.text().size(), isFatal}; } -bool IsDefinedOperator(const SourceName &name) { - const char *begin{name.begin()}; - const char *end{name.end()}; - return begin != end && begin[0] == '.' && end[-1] == '.'; -} - bool IsIntrinsicOperator( const SemanticsContext &context, const SourceName &name) { std::string str{name.ToString()}; diff --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h index 08db703..17462d1 100644 --- a/flang/lib/Semantics/resolve-names-utils.h +++ b/flang/lib/Semantics/resolve-names-utils.h @@ -47,8 +47,6 @@ Symbol *Resolve(const parser::Name &, Symbol *); parser::MessageFixedText WithIsFatal( const parser::MessageFixedText &msg, bool isFatal); -// Is this the name of a defined operator, e.g. ".foo." -bool IsDefinedOperator(const SourceName &); bool IsIntrinsicOperator(const SemanticsContext &, const SourceName &); bool IsLogicalConstant(const SemanticsContext &, const SourceName &); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 5468623..b501ac6 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -2276,19 +2276,13 @@ ModuleVisitor::SymbolRename ModuleVisitor::AddUse( return {}; // error occurred finding module } if (!useSymbol) { - Say(useName, - IsDefinedOperator(useName) - ? "Operator '%s' not found in module '%s'"_err_en_US - : "'%s' not found in module '%s'"_err_en_US, - useName, useModuleScope_->GetName().value()); + Say(useName, "'%s' not found in module '%s'"_err_en_US, MakeOpName(useName), + useModuleScope_->GetName().value()); return {}; } if (useSymbol->attrs().test(Attr::PRIVATE)) { - Say(useName, - IsDefinedOperator(useName) - ? "Operator '%s' is PRIVATE in '%s'"_err_en_US - : "'%s' is PRIVATE in '%s'"_err_en_US, - useName, useModuleScope_->GetName().value()); + Say(useName, "'%s' is PRIVATE in '%s'"_err_en_US, MakeOpName(useName), + useModuleScope_->GetName().value()); return {}; } auto &localSymbol{MakeSymbol(localName)}; @@ -2550,11 +2544,9 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) { } } if (!namesSeen.insert(name->source).second) { - Say(*name, - details.kind().IsDefinedOperator() - ? "Procedure '%s' is already specified in generic operator '%s'"_err_en_US - : "Procedure '%s' is already specified in generic '%s'"_err_en_US, - name->source, generic.name()); + Say(name->source, + "Procedure '%s' is already specified in generic '%s'"_err_en_US, + name->source, MakeOpName(generic.name())); continue; } details.AddSpecificProc(*symbol, name->source); @@ -5932,10 +5924,11 @@ Symbol &ModuleVisitor::SetAccess( if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) { // PUBLIC/PRIVATE already set: make it a fatal error if it changed Attr prev = attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE; - auto msg{IsDefinedOperator(name) - ? "The accessibility of operator '%s' has already been specified as %s"_en_US - : "The accessibility of '%s' has already been specified as %s"_en_US}; - Say(name, WithIsFatal(msg, attr != prev), name, EnumToString(prev)); + Say(name, + WithIsFatal( + "The accessibility of '%s' has already been specified as %s"_en_US, + attr != prev), + MakeOpName(name), EnumToString(prev)); } else { attrs.set(attr); } diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 7a79ded..848aef0 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -156,6 +156,19 @@ bool IsGenericDefinedOp(const Symbol &symbol) { } } +bool IsDefinedOperator(SourceName name) { + const char *begin{name.begin()}; + const char *end{name.end()}; + return begin != end && begin[0] == '.' && end[-1] == '.'; +} + +std::string MakeOpName(SourceName name) { + std::string result{name.ToString()}; + return IsDefinedOperator(name) ? "OPERATOR(" + result + ")" + : result.find("operator(", 0) == 0 ? parser::ToUpperCaseLetters(result) + : result; +} + bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) { const auto &objects{block.get().objects()}; auto found{std::find(objects.begin(), objects.end(), object)}; diff --git a/flang/test/Semantics/resolve11.f90 b/flang/test/Semantics/resolve11.f90 index 60dfcb8..06c57b6 100644 --- a/flang/test/Semantics/resolve11.f90 +++ b/flang/test/Semantics/resolve11.f90 @@ -13,13 +13,13 @@ module m2 module procedure ifoo end interface public :: operator(.foo.) - !ERROR: The accessibility of operator '.foo.' has already been specified as PUBLIC + !ERROR: The accessibility of 'OPERATOR(.foo.)' has already been specified as PUBLIC private :: operator(.foo.) interface operator(+) module procedure ifoo end interface public :: operator(+) - !ERROR: The accessibility of 'operator(+)' has already been specified as PUBLIC + !ERROR: The accessibility of 'OPERATOR(+)' has already been specified as PUBLIC private :: operator(+) , ifoo contains integer function ifoo(x, y) @@ -37,7 +37,7 @@ module m3 type(t), intent(in) :: x, y end function end interface - !ERROR: The accessibility of 'operator(<)' has already been specified as PRIVATE + !ERROR: The accessibility of 'OPERATOR(<)' has already been specified as PRIVATE public :: operator(<) interface operator(.gt.) logical function gt(x, y) @@ -46,6 +46,6 @@ module m3 end function end interface public :: operator(>) - !ERROR: The accessibility of 'operator(.gt.)' has already been specified as PUBLIC + !ERROR: The accessibility of 'OPERATOR(.GT.)' has already been specified as PUBLIC private :: operator(.gt.) end diff --git a/flang/test/Semantics/resolve13.f90 b/flang/test/Semantics/resolve13.f90 index a611aa0..f6105b1 100644 --- a/flang/test/Semantics/resolve13.f90 +++ b/flang/test/Semantics/resolve13.f90 @@ -27,24 +27,24 @@ use m1, local_y => y !ERROR: 'z' not found in module 'm1' use m1, local_z => z use m1, operator(.localfoo.) => operator(.foo.) -!ERROR: Operator '.bar.' not found in module 'm1' +!ERROR: 'OPERATOR(.bar.)' not found in module 'm1' use m1, operator(.localbar.) => operator(.bar.) !ERROR: 'y' is PRIVATE in 'm1' use m1, only: y -!ERROR: Operator '.priv.' is PRIVATE in 'm1' +!ERROR: 'OPERATOR(.priv.)' is PRIVATE in 'm1' use m1, only: operator(.priv.) -!ERROR: 'operator(*)' is PRIVATE in 'm1' +!ERROR: 'OPERATOR(*)' is PRIVATE in 'm1' use m1, only: operator(*) !ERROR: 'z' not found in module 'm1' use m1, only: z !ERROR: 'z' not found in module 'm1' use m1, only: my_x => z use m1, only: operator(.foo.) -!ERROR: Operator '.bar.' not found in module 'm1' +!ERROR: 'OPERATOR(.bar.)' not found in module 'm1' use m1, only: operator(.bar.) use m1, only: operator(-) , ifoo -!ERROR: 'operator(+)' not found in module 'm1' +!ERROR: 'OPERATOR(+)' not found in module 'm1' use m1, only: operator(+) end diff --git a/flang/test/Semantics/resolve15.f90 b/flang/test/Semantics/resolve15.f90 index 3658a68..c520c58 100644 --- a/flang/test/Semantics/resolve15.f90 +++ b/flang/test/Semantics/resolve15.f90 @@ -9,7 +9,9 @@ module m end interface interface operator(.foo.) !ERROR: 'var' is not a subprogram - procedure :: sub, var + procedure :: var + !ERROR: OPERATOR(.foo.) procedure 'sub' must be a function + procedure :: sub !ERROR: Procedure 'bad' not found procedure :: bad end interface diff --git a/flang/test/Semantics/resolve25.f90 b/flang/test/Semantics/resolve25.f90 index 3264194..ec0a98a 100644 --- a/flang/test/Semantics/resolve25.f90 +++ b/flang/test/Semantics/resolve25.f90 @@ -1,7 +1,7 @@ ! RUN: %S/test_errors.sh %s %t %f18 module m interface foo - subroutine s1(x) + real function s1(x) real x end !ERROR: 's2' is not a module procedure @@ -12,12 +12,12 @@ module m procedure s1 end interface interface - subroutine s4(x,y) - real x,y - end subroutine - subroutine s2(x,y) - complex x,y - end subroutine + real function s4(x,y) + real, intent(in) :: x,y + end function + complex function s2(x,y) + complex, intent(in) :: x,y + end function end interface generic :: bar => s4 generic :: bar => s2 @@ -26,7 +26,7 @@ module m generic :: operator(.foo.)=> s4 generic :: operator(.foo.)=> s2 - !ERROR: Procedure 's4' is already specified in generic operator '.foo.' + !ERROR: Procedure 's4' is already specified in generic 'OPERATOR(.foo.)' generic :: operator(.foo.)=> s4 end module @@ -37,7 +37,7 @@ module m2 end function end interface generic :: operator(+)=> f - !ERROR: Procedure 'f' is already specified in generic 'operator(+)' + !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(+)' generic :: operator(+)=> f end @@ -46,11 +46,11 @@ module m3 procedure f end interface interface operator(>=) - !ERROR: Procedure 'f' is already specified in generic 'operator(.ge.)' + !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(.GE.)' procedure f end interface generic :: operator(>) => f - !ERROR: Procedure 'f' is already specified in generic 'operator(>)' + !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(>)' generic :: operator(.gt.) => f contains logical function f(x, y) result(result) diff --git a/flang/test/Semantics/resolve53.f90 b/flang/test/Semantics/resolve53.f90 index acb27c8..1487873 100644 --- a/flang/test/Semantics/resolve53.f90 +++ b/flang/test/Semantics/resolve53.f90 @@ -210,7 +210,7 @@ module m14 module procedure f1 module procedure f2 end interface - !ERROR: Generic 'operator(+)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable + !ERROR: Generic 'OPERATOR(+)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable interface operator(+) module procedure f1 module procedure f3 @@ -219,7 +219,7 @@ module m14 module procedure f1 module procedure f2 end interface - !ERROR: Generic operator '.bar.' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable + !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable interface operator(.bar.) module procedure f1 module procedure f3 @@ -332,7 +332,6 @@ contains end subroutine end - ! Check that specifics for type-bound generics can be distinguished module m16 type :: t @@ -441,20 +440,20 @@ module m19 module procedure f1 module procedure f2 end interface - !ERROR: Generic operator '.bar.' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable + !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable interface operator(.bar.) module procedure f2 module procedure f3 end interface contains integer function f1(i) - integer :: i + integer, intent(in) :: i end integer function f2(i, j) - integer :: i, j + integer, value :: i, j end integer function f3(i, j) - integer :: i, j + integer, intent(in) :: i, j end end @@ -472,11 +471,11 @@ end module subroutine s1() use m20 interface operator(.not.) - !ERROR: Procedure 'f' is already specified in generic 'operator(.not.)' + !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(.NOT.)' procedure f end interface interface operator(+) - !ERROR: Procedure 'f' is already specified in generic 'operator(+)' + !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(+)' procedure f end interface end subroutine s1 diff --git a/flang/test/Semantics/resolve96.f90 b/flang/test/Semantics/resolve96.f90 new file mode 100644 index 0000000..b026e04 --- /dev/null +++ b/flang/test/Semantics/resolve96.f90 @@ -0,0 +1,62 @@ +! RUN: %S/test_errors.sh %s %t %f18 + +! Check distinguishability for specific procedures of defined operators and +! assignment. These are different from names because there a normal generic +! is invoked the same way as a type-bound generic. +! E.g. for a generic name like 'foo', the generic name is invoked as 'foo(x, y)' +! while the type-bound generic is invoked as 'x%foo(y)'. +! But for 'operator(.foo.)', it is 'x .foo. y' in either case. +! So to check the specifics of 'operator(.foo.)' we have to consider all +! definitions of it visible in the current scope. + +! One operator(.foo.) comes from interface-stmt, the other is type-bound. +module m1 + type :: t1 + contains + procedure, pass :: p => s1 + generic :: operator(.foo.) => p + end type + type :: t2 + end type + !ERROR: Generic 'OPERATOR(.foo.)' may not have specific procedures 's2' and 't1%p' as their interfaces are not distinguishable + interface operator(.foo.) + procedure :: s2 + end interface +contains + integer function s1(x1, x2) + class(t1), intent(in) :: x1 + class(t2), intent(in) :: x2 + end + integer function s2(x1, x2) + class(t1), intent(in) :: x1 + class(t2), intent(in) :: x2 + end +end module + +! assignment(=) as type-bound generic in each type +module m2 + type :: t1 + integer :: n + contains + procedure, pass(x1) :: p1 => s1 + !ERROR: Generic 'assignment(=)' may not have specific procedures 't1%p1' and 't2%p2' as their interfaces are not distinguishable + generic :: assignment(=) => p1 + end type + type :: t2 + integer :: n + contains + procedure, pass(x2) :: p2 => s2 + generic :: assignment(=) => p2 + end type +contains + subroutine s1(x1, x2) + class(t1), intent(out) :: x1 + class(t2), intent(in) :: x2 + x1%n = x2%n + 1 + end subroutine + subroutine s2(x1, x2) + class(t1), intent(out) :: x1 + class(t2), intent(in) :: x2 + x1%n = x2%n + 2 + end subroutine +end module diff --git a/flang/test/Semantics/test_errors.sh b/flang/test/Semantics/test_errors.sh index 1538347..5411482 100755 --- a/flang/test/Semantics/test_errors.sh +++ b/flang/test/Semantics/test_errors.sh @@ -2,7 +2,7 @@ # Compile a source file and check errors against those listed in the file. # Change the compiler by setting the F18 environment variable. -F18_OPTIONS="-fdebug-resolve-names -fparse-only" +F18_OPTIONS="-fparse-only" srcdir=$(dirname $0) source $srcdir/common.sh [[ ! -f $src ]] && die "File not found: $src" -- 2.7.4