std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
bool AreConformable() const;
- const Symbol *FindBoundOp(
- parser::CharBlock, int passIndex, const Symbol *&definedOp);
+ const Symbol *FindBoundOp(parser::CharBlock, int passIndex,
+ const Symbol *&definedOp, bool isSubroutine);
void AddAssignmentConversion(
const DynamicType &lhsType, const DynamicType &rhsType);
bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
// re-resolve the name to the specific binding
sc.component.symbol = const_cast<Symbol *>(sym);
} else {
- EmitGenericResolutionError(*sc.component.symbol, pair.second);
+ EmitGenericResolutionError(
+ *sc.component.symbol, pair.second, isSubroutine);
return std::nullopt;
}
}
return IsBareNullPointer(iter->UnwrapExpr());
}) != actuals.end()};
for (const Symbol &specific : details->specificProcs()) {
+ if (isSubroutine != !IsFunction(specific)) {
+ continue;
+ }
if (!ResolveForward(specific)) {
continue;
}
}
void ExpressionAnalyzer::EmitGenericResolutionError(
- const Symbol &symbol, bool dueToNullActuals) {
+ const Symbol &symbol, bool dueToNullActuals, bool isSubroutine) {
Say(dueToNullActuals
? "One or more NULL() actual arguments to the generic procedure '%s' requires a MOLD= for disambiguation"_err_en_US
: semantics::IsGenericDefinedOp(symbol)
? "No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US
- : "No specific procedure of generic '%s' matches the actual arguments"_err_en_US,
+ : isSubroutine
+ ? "No specific subroutine of generic '%s' matches the actual arguments"_err_en_US
+ : "No specific function of generic '%s' matches the actual arguments"_err_en_US,
symbol.name());
}
std::move(specificCall->arguments)};
} else {
if (isGenericInterface) {
- EmitGenericResolutionError(*symbol, dueToNullActual);
+ EmitGenericResolutionError(*symbol, dueToNullActual, isSubroutine);
}
return std::nullopt;
}
}
}
for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
- if (const Symbol *symbol{
- FindBoundOp(oprName, passIndex, *definedOpSymbolPtr)}) {
+ if (const Symbol *
+ symbol{FindBoundOp(oprName, passIndex, *definedOpSymbolPtr, false)}) {
if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
return result;
}
if (pair.first) {
proc = pair.first;
} else {
- context_.EmitGenericResolutionError(*symbol, pair.second);
+ context_.EmitGenericResolutionError(*symbol, pair.second, true);
}
}
int passedObjectIndex{-1};
const Symbol *definedOpSymbol{nullptr};
for (std::size_t i{0}; i < actuals_.size(); ++i) {
- if (const Symbol *specific{FindBoundOp(oprName, i, definedOpSymbol)}) {
- if (const Symbol *resolution{
- GetBindingResolution(GetType(i), *specific)}) {
+ if (const Symbol *
+ specific{FindBoundOp(oprName, i, definedOpSymbol, true)}) {
+ if (const Symbol *
+ resolution{GetBindingResolution(GetType(i), *specific)}) {
proc = resolution;
} else {
proc = specific;
}
// Look for a type-bound operator in the type of arg number passIndex.
-const Symbol *ArgumentAnalyzer::FindBoundOp(
- parser::CharBlock oprName, int passIndex, const Symbol *&definedOp) {
+const Symbol *ArgumentAnalyzer::FindBoundOp(parser::CharBlock oprName,
+ int passIndex, const Symbol *&definedOp, bool isSubroutine) {
const auto *type{GetDerivedTypeSpec(GetType(passIndex))};
if (!type || !type->scope()) {
return nullptr;
[&](const Symbol &proc, ActualArguments &) {
return passIndex == GetPassIndex(proc);
}};
- auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment, false)};
+ auto pair{
+ context_.ResolveGeneric(*symbol, actuals_, adjustment, isSubroutine)};
if (!pair.first) {
- context_.EmitGenericResolutionError(*symbol, pair.second);
+ context_.EmitGenericResolutionError(*symbol, pair.second, isSubroutine);
}
return pair.first;
}
specificProcs_.erase(range.first, range.second);
}
-// Check that the specific procedures are all functions or all subroutines.
-// If there is a derived type with the same name they must be functions.
-// Set the corresponding flag on generic.
+// Mixed interfaces are allowed by the standard.
+// If there is a derived type with the same name, they must all be functions.
void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
ResolveSpecificsInGeneric(generic);
auto &details{generic.get<GenericDetails>()};
}
const Symbol &firstSpecific{specifics.front()};
bool isFunction{firstSpecific.test(Symbol::Flag::Function)};
+ bool isBoth{false};
for (const Symbol &specific : specifics) {
if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514
auto &msg{Say(generic.name(),
- "Generic interface '%s' has both a function and a subroutine"_err_en_US)};
+ "Generic interface '%s' has both a function and a subroutine"_warn_en_US)};
if (isFunction) {
msg.Attach(firstSpecific.name(), "Function declaration"_en_US);
msg.Attach(specific.name(), "Subroutine declaration"_en_US);
msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US);
msg.Attach(specific.name(), "Function declaration"_en_US);
}
+ isFunction = false;
+ isBoth = true;
+ break;
}
}
if (!isFunction && details.derivedType()) {
" with same name"_err_en_US,
*details.derivedType()->GetUltimate().scope());
}
- generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
+ if (!isBoth) {
+ generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
+ }
}
// SubprogramVisitor implementation