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()); }
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) {
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_);
// 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) {
// - 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 &,
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?
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
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) {
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
}
// 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;
} 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;
}
// 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) {
// 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"
return true; // OK
}
SayWithDeclaration(specific, std::move(msg.value()), specific.name());
+ context_.SetError(specific);
return false;
}
}
if (msg) {
SayWithDeclaration(symbol, std::move(*msg), symbol.name(), arg.name);
+ context_.SetError(symbol);
return false;
}
return true;
}
}
-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,
? "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)) {
if (scope.kind() == Scope::Kind::BlockData) {
CheckBlockData(scope);
}
+ CheckGenericOps(scope);
}
void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &set) {
}
}
+// 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>()};
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;
}
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);
}
bool SubprogramMatchHelper::ShapesAreCompatible(
const DummyDataObject &obj1, const DummyDataObject &obj2) {
- return evaluate::characteristics::ShapesAreCompatible(
+ return characteristics::ShapesAreCompatible(
FoldShape(obj1.type.shape()), FoldShape(obj2.type.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();
}