[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
This commit is contained in:
Tim Keith
2020-09-10 07:22:52 -07:00
parent 4e413e1621
commit 82edd428f1
14 changed files with 300 additions and 152 deletions

View File

@@ -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 &);

View File

@@ -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();

View File

@@ -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 <typename A> 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<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 @@ 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<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 @@ 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<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);
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 result;
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 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();
}

View File

@@ -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()};

View File

@@ -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 &);

View File

@@ -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);
}

View File

@@ -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)};

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -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"