[flang-commits] [flang] 82edd42 - [flang] Fix check for distinguishable operators/assignments
Tim Keith via flang-commits
flang-commits at lists.llvm.org
Thu Sep 10 07:39:48 PDT 2020
Author: Tim Keith
Date: 2020-09-10T07:22:55-07:00
New Revision: 82edd428f1856ff386716b4f836194252458d001
URL: https://github.com/llvm/llvm-project/commit/82edd428f1856ff386716b4f836194252458d001
DIFF: https://github.com/llvm/llvm-project/commit/82edd428f1856ff386716b4f836194252458d001.diff
LOG: [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
Added:
flang/test/Semantics/resolve96.f90
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/resolve-names-utils.cpp
flang/lib/Semantics/resolve-names-utils.h
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/resolve11.f90
flang/test/Semantics/resolve13.f90
flang/test/Semantics/resolve15.f90
flang/test/Semantics/resolve25.f90
flang/test/Semantics/resolve53.f90
flang/test/Semantics/test_errors.sh
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index adc722c3847f..58ba7bf70017 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 128a73ad4c78..4edf90d37fa5 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -813,8 +813,8 @@ parser::Message *AttachDeclaration(
unhosted->detailsIf<semantics::ProcBindingDetails>()}) {
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 df7ae6e53b1f..896af3cc83e0 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 @@ class CheckHelper {
void Check(const Symbol &);
void Check(const Scope &);
void CheckInitialization(const Symbol &);
+ const Procedure *Characterize(const Symbol &);
private:
template <typename A> void CheckSpecExpr(const A &x) {
@@ -63,24 +66,20 @@ class CheckHelper {
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<std::vector<Procedure>> 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<parser::MessageFixedText> 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<Procedure> &);
+ 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 @@ class CheckHelper {
// 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<SymbolRef, std::optional<Procedure>> 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<SourceName, std::vector<ProcedureInfo>> 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 @@ class SubprogramMatchHelper {
return parser::ToUpperCaseLetters(DummyProcedure::EnumToString(attr));
}
- SemanticsContext &context;
+ CheckHelper &checkHelper;
};
// 15.6.2.6 para 3 - can the result of an ENTRY
diff er 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<std::vector<Procedure>> 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<Procedure> &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<DummyDataObject>(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<parser::MessageFixedText> 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<parser::MessageFixedText> 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<parser::MessageFixedText> 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<std::vector<Procedure>> CheckHelper::Characterize(
- const SymbolVector &specifics) {
- std::vector<Procedure> 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<GenericDetails>()};
+ if (!details) {
+ return;
+ }
+ GenericKind kind{details->kind()};
+ if (!kind.IsAssignment() && !kind.IsOperator()) {
+ return;
+ }
+ const SymbolVector &specifics{details->specificProcs()};
+ const std::vector<SourceName> &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<DerivedTypeDetails>()) {
+ 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<SubprogramDetails>()};
@@ -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 <typename... A>
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<A>(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
diff erent 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 d6f0302e9854..8dbd25e163ac 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 08db70345f15..17462d111d97 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 54686232dc0d..b501ac69098f 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 7a79dedb00a3..848aef08e3a1 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<CommonBlockDetails>().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 60dfcb8a1024..06c57b6e4cb8 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 @@ logical function lt(x, y)
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 @@ logical function gt(x, y)
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 a611aa09e5cc..f6105b1ec8a8 100644
--- a/flang/test/Semantics/resolve13.f90
+++ b/flang/test/Semantics/resolve13.f90
@@ -27,24 +27,24 @@ integer function ifoo(x, 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 3658a68e1e88..c520c5886599 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 3264194993ea..ec0a98ad6a59 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 @@ subroutine s1(x)
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 @@ subroutine s2(x,y)
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 @@ integer function f(x, y)
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 acb27c8575b7..1487873bd86b 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 @@ subroutine s9(x)
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 @@ real function f(x)
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 000000000000..b026e042397e
--- /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
diff erent 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 15383475c505..5411482e4d3b 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"
More information about the flang-commits
mailing list