Details details_;
Symbol() {} // only created in class Symbols
- const std::string GetDetailsName() const;
+ std::string GetDetailsName() const;
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
friend llvm::raw_ostream &DumpForUnparse(
llvm::raw_ostream &, const Symbol &, bool);
const Symbol *FindSubprogram(const Symbol &);
const Symbol *FindFunctionResult(const Symbol &);
const Symbol *FindOverriddenBinding(const Symbol &);
+const Symbol *FindGlobal(const Symbol &);
const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &);
const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &);
bool IsProcedure(const Symbol &symbol) {
return common::visit(common::visitors{
- [](const SubprogramDetails &) { return true; },
+ [&symbol](const SubprogramDetails &) {
+ const Scope *scope{symbol.scope()};
+ // Main programs & BLOCK DATA are not procedures.
+ return !scope ||
+ scope->kind() == Scope::Kind::Subprogram;
+ },
[](const SubprogramNameDetails &) { return true; },
[](const ProcEntityDetails &) { return true; },
[](const GenericDetails &) { return true; },
.AnyFatalError();
}
-void CheckArguments(const characteristics::Procedure &proc,
+bool CheckArguments(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
const Scope &scope, bool treatingExternalAsImplicit,
const evaluate::SpecificIntrinsic *intrinsic) {
if (auto *msgs{messages.messages()}) {
msgs->Annex(std::move(buffer));
}
- return; // don't pile on
+ return false; // don't pile on
}
}
if (explicitInterface) {
auto buffer{
CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
- if (treatingExternalAsImplicit && !buffer.empty()) {
- if (auto *msg{messages.Say(
- "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) {
- buffer.AttachTo(*msg, parser::Severity::Because);
+ if (!buffer.empty()) {
+ if (treatingExternalAsImplicit && !buffer.empty()) {
+ if (auto *msg{messages.Say(
+ "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) {
+ buffer.AttachTo(*msg, parser::Severity::Because);
+ }
}
- }
- if (auto *msgs{messages.messages()}) {
- msgs->Annex(std::move(buffer));
+ if (auto *msgs{messages.messages()}) {
+ msgs->Annex(std::move(buffer));
+ }
+ return false;
}
}
+ return true;
}
} // namespace Fortran::semantics
// Argument treatingExternalAsImplicit should be true when the called procedure
// does not actually have an explicit interface at the call site, but
// its characteristics are known because it is a subroutine or function
-// defined at the top level in the same source file.
-void CheckArguments(const evaluate::characteristics::Procedure &,
+// defined at the top level in the same source file. Returns false if
+// messages were created, true if all is well.
+bool CheckArguments(const evaluate::characteristics::Procedure &,
evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
bool treatingExternalAsImplicit,
const evaluate::SpecificIntrinsic *intrinsic);
void CheckArraySpec(const Symbol &, const ArraySpec &);
void CheckProcEntity(const Symbol &, const ProcEntityDetails &);
void CheckSubprogram(const Symbol &, const SubprogramDetails &);
+ void CheckLocalVsGlobal(const Symbol &);
void CheckAssumedTypeEntity(const Symbol &, const ObjectEntityDetails &);
void CheckDerivedType(const Symbol &, const DerivedTypeDetails &);
bool CheckFinal(
return subp && subp->isInterface();
}
template <typename... A>
- void SayWithDeclaration(const Symbol &symbol, A &&...x) {
- if (parser::Message * msg{messages_.Say(std::forward<A>(x)...)}) {
- if (messages_.at().begin() != symbol.name().begin()) {
- evaluate::AttachDeclaration(*msg, symbol);
- }
+ parser::Message *SayWithDeclaration(const Symbol &symbol, A &&...x) {
+ parser::Message *msg{messages_.Say(std::forward<A>(x)...)};
+ if (msg && messages_.at().begin() != symbol.name().begin()) {
+ evaluate::AttachDeclaration(*msg, symbol);
}
+ return msg;
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckBindC(const Symbol &);
const DeclTypeSpec &type, bool canHaveAssumedTypeParameters) {
if (type.category() == DeclTypeSpec::Character) {
Check(type.characterTypeSpec().length(), canHaveAssumedTypeParameters);
- } else if (const DerivedTypeSpec * derived{type.AsDerived()}) {
+ } else if (const DerivedTypeSpec *derived{type.AsDerived()}) {
for (auto &parm : derived->parameters()) {
Check(parm.second, canHaveAssumedTypeParameters);
}
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
}
- if (const Symbol * result{FindFunctionResult(symbol)}) {
+ if (const Symbol *result{FindFunctionResult(symbol)}) {
if (IsPointer(*result)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
void CheckHelper::CheckAssumedTypeEntity( // C709
const Symbol &symbol, const ObjectEntityDetails &details) {
- if (const DeclTypeSpec * type{symbol.GetType()};
+ if (const DeclTypeSpec *type{symbol.GetType()};
type && type->category() == DeclTypeSpec::TypeStar) {
if (!IsDummy(symbol)) {
messages_.Say(
symbol.name());
}
}
- if (const DeclTypeSpec * type{details.type()}) {
+ if (const DeclTypeSpec *type{details.type()}) {
if (IsBadCoarrayType(type->AsDerived())) { // C747 & C824
messages_.Say(
"Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US,
messages_.Say(
"non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE"_err_en_US);
} else if (IsIntentOut(symbol)) {
- if (const DeclTypeSpec * type{details.type()}) {
+ if (const DeclTypeSpec *type{details.type()}) {
if (type && type->IsPolymorphic()) { // C1588
messages_.Say(
"An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic"_err_en_US);
- } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+ } else if (const DerivedTypeSpec *derived{type->AsDerived()}) {
if (FindUltimateComponent(*derived, [](const Symbol &x) {
const DeclTypeSpec *type{x.GetType()};
return type && type->IsPolymorphic();
"An initialized variable in BLOCK DATA must be in a COMMON block"_err_en_US);
}
}
- if (const DeclTypeSpec * type{details.type()}) { // C708
+ if (const DeclTypeSpec *type{details.type()}) { // C708
if (type->IsPolymorphic() &&
!(type->IsAssumedType() || IsAllocatableOrPointer(symbol) ||
IsDummy(symbol))) {
messages_.Say(
"An ELEMENTAL subprogram may not have a dummy procedure"_err_en_US);
}
- const Symbol *interface { details.interface().symbol() };
+ const Symbol *interface {
+ details.interface().symbol()
+ };
if (!symbol.attrs().test(Attr::INTRINSIC) &&
(IsElementalProcedure(symbol) ||
(interface && !interface->attrs().test(Attr::INTRINSIC) &&
}
if (symbol.attrs().test(Attr::POINTER)) {
CheckPointerInitialization(symbol);
- if (const Symbol * interface{details.interface().symbol()}) {
+ if (const Symbol *interface{details.interface().symbol()}) {
const Symbol &ultimate{interface->GetUltimate()};
if (ultimate.attrs().test(Attr::INTRINSIC)) {
if (const auto intrinsic{
"Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US,
symbol.name());
}
+ CheckLocalVsGlobal(symbol);
}
// When a module subprogram has the MODULE prefix the following must match
void CheckHelper::CheckSubprogram(
const Symbol &symbol, const SubprogramDetails &details) {
- if (const Symbol * iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
+ if (const Symbol *iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
SubprogramMatchHelper{*this}.Check(symbol, *iface);
}
- if (const Scope * entryScope{details.entryScope()}) {
+ if (const Scope *entryScope{details.entryScope()}) {
// ENTRY 15.6.2.6, esp. C1571
std::optional<parser::MessageFixedText> error;
const Symbol *subprogram{entryScope->symbol()};
}
}
}
- if (details.isInterface() && !details.isDummy() && details.isFunction() &&
- IsAssumedLengthCharacter(details.result())) { // C721
- messages_.Say(details.result().name(),
- "A function interface may not declare an assumed-length CHARACTER(*) result"_err_en_US);
+ if (details.isInterface()) {
+ if (!details.isDummy() && details.isFunction() &&
+ IsAssumedLengthCharacter(details.result())) { // C721
+ messages_.Say(details.result().name(),
+ "A function interface may not declare an assumed-length CHARACTER(*) result"_err_en_US);
+ }
+ }
+ CheckLocalVsGlobal(symbol);
+}
+
+void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
+ if (IsProcedure(symbol) && IsExternal(symbol)) {
+ if (const Symbol *global{FindGlobal(symbol)}; global && global != &symbol) {
+ std::string interfaceName{symbol.name().ToString()};
+ if (const auto *bind{symbol.GetBindName()}) {
+ interfaceName = *bind;
+ }
+ std::string definitionName{global->name().ToString()};
+ if (const auto *bind{global->GetBindName()}) {
+ definitionName = *bind;
+ }
+ if (interfaceName == definitionName) {
+ parser::Message *msg{nullptr};
+ if (!IsProcedure(*global)) {
+ if (symbol.flags().test(Symbol::Flag::Function) ||
+ symbol.flags().test(Symbol::Flag::Subroutine)) {
+ msg = messages_.Say(
+ "The global entity '%s' corresponding to the local procedure '%s' is not a callable subprogram"_err_en_US,
+ global->name(), symbol.name());
+ }
+ } else if (auto chars{Characterize(symbol)}) {
+ if (auto globalChars{Characterize(*global)}) {
+ if (chars->HasExplicitInterface()) {
+ std::string whyNot;
+ if (!chars->IsCompatibleWith(*globalChars, &whyNot)) {
+ msg = messages_.Say(
+ "The global subprogram '%s' is not compatible with its local procedure declaration (%s)"_warn_en_US,
+ global->name(), whyNot);
+ }
+ } else if (!globalChars->CanBeCalledViaImplicitInterface()) {
+ msg = messages_.Say(
+ "The global subprogram '%s' may not be referenced via the implicit interface '%s'"_err_en_US,
+ global->name(), symbol.name());
+ }
+ }
+ }
+ evaluate::AttachDeclaration(msg, *global);
+ evaluate::AttachDeclaration(msg, symbol);
+ }
+ }
}
}
(derivedType.attrs().test(Attr::BIND_C) || details.sequence())) {
messages_.Say("An ABSTRACT derived type must be extensible"_err_en_US);
}
- if (const DeclTypeSpec * parent{FindParentTypeSpec(derivedType)}) {
+ if (const DeclTypeSpec *parent{FindParentTypeSpec(derivedType)}) {
const DerivedTypeSpec *parentDerived{parent->AsDerived()};
if (!IsExtensibleType(parentDerived)) { // C705
messages_.Say("The parent type is not extensible"_err_en_US);
const Symbol *errSym{&subroutine};
if (const auto *details{subroutine.detailsIf<SubprogramDetails>()}) {
if (!details->dummyArgs().empty()) {
- if (const Symbol * argSym{details->dummyArgs()[0]}) {
+ if (const Symbol *argSym{details->dummyArgs()[0]}) {
errSym = argSym;
}
}
}
DistinguishabilityHelper helper{context_};
for (const Symbol &specific : details.specificProcs()) {
- if (const Procedure * procedure{Characterize(specific)}) {
+ if (const Procedure *procedure{Characterize(specific)}) {
if (procedure->HasExplicitInterface()) {
helper.Add(generic, kind, specific, *procedure);
} else {
return;
}
const auto &name{proc.name()};
- const Symbol *interface { interface0 ? FindInterface(*interface0) : nullptr };
+ const Symbol *interface {
+ interface0 ? FindInterface(*interface0) : nullptr
+ };
if (!interface) {
messages_.Say(name,
"Procedure component '%s' must have NOPASS attribute or explicit interface"_err_en_US,
const Scope &dtScope{symbol.owner()};
CHECK(dtScope.kind() == Scope::Kind::DerivedType);
if (symbol.attrs().test(Attr::DEFERRED)) {
- if (const Symbol * dtSymbol{dtScope.symbol()}) {
+ if (const Symbol *dtSymbol{dtScope.symbol()}) {
if (!dtSymbol->attrs().test(Attr::ABSTRACT)) { // C733
SayWithDeclaration(*dtSymbol,
"Procedure bound to non-ABSTRACT derived type '%s' may not be DEFERRED"_err_en_US,
"Intrinsic procedure '%s' is not a specific intrinsic permitted for use in the definition of binding '%s'"_err_en_US,
binding.symbol().name(), symbol.name());
}
- if (const Symbol * overridden{FindOverriddenBinding(symbol)}) {
+ if (const Symbol *overridden{FindOverriddenBinding(symbol)}) {
if (overridden->attrs().test(Attr::NON_OVERRIDABLE)) {
SayWithDeclaration(*overridden,
"Override of NON_OVERRIDABLE '%s' is not permitted"_err_en_US,
void CheckHelper::Check(const Scope &scope) {
scope_ = &scope;
common::Restorer<const Symbol *> restorer{innermostSymbol_, innermostSymbol_};
- if (const Symbol * symbol{scope.symbol()}) {
+ if (const Symbol *symbol{scope.symbol()}) {
innermostSymbol_ = symbol;
}
if (scope.IsParameterizedDerivedTypeInstantiation()) {
// Not a generic; ensure characteristics are defined if a function.
auto restorer{messages_.SetLocation(generic.name())};
if (IsFunction(generic) && !context_.HasError(generic)) {
- if (const Symbol * result{FindFunctionResult(generic)};
+ if (const Symbol *result{FindFunctionResult(generic)};
result && !context_.HasError(*result)) {
Characterize(generic);
}
for (std::size_t i{0}; i < specifics.size(); ++i) {
const Symbol &specific{*specifics[i]};
auto restorer{messages_.SetLocation(bindingNames[i])};
- if (const Procedure * proc{Characterize(specific)}) {
+ if (const Procedure *proc{Characterize(specific)}) {
if (kind.IsAssignment()) {
if (!CheckDefinedAssignment(specific, *proc)) {
continue;
addSpecifics(symbol);
const Symbol &ultimate{symbol.GetUltimate()};
if (ultimate.has<DerivedTypeDetails>()) {
- if (const Scope * typeScope{ultimate.scope()}) {
+ if (const Scope *typeScope{ultimate.scope()}) {
for (const auto &pair2 : *typeScope) {
addSpecifics(*pair2.second);
}
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
context_.SetError(symbol);
}
- if (const std::string * name{DefinesBindCName(symbol)}) {
+ if (const std::string *name{DefinesBindCName(symbol)}) {
auto pair{bindC_.emplace(*name, symbol)};
if (!pair.second) {
const Symbol &other{*pair.first->second};
void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
GenericKind::DefinedIo ioKind, const Symbol &generic) {
- if (const DeclTypeSpec * type{arg.GetType()}) {
- if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
+ if (const DeclTypeSpec *type{arg.GetType()}) {
+ if (const DerivedTypeSpec *derivedType{type->AsDerived()}) {
CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
bool isPolymorphic{type->IsPolymorphic()};
if (isPolymorphic != IsExtensibleType(derivedType)) {
void CheckHelper::CheckDioDummyIsDefaultInteger(
const Symbol &subp, const Symbol &arg) {
- if (const DeclTypeSpec * type{arg.GetType()};
+ if (const DeclTypeSpec *type{arg.GetType()};
type && type->IsNumeric(TypeCategory::Integer)) {
if (const auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
kind && *kind == context_.GetDefaultKind(TypeCategory::Integer)) {
static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
const std::optional<parser::TypeSpec> &spec) {
if (spec) {
- if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
+ if (const semantics::DeclTypeSpec *typeSpec{spec->declTypeSpec}) {
// Name resolution sets TypeSpec::declTypeSpec only when it's valid
// (viz., an intrinsic type with valid known kind or a non-polymorphic
// & non-ABSTRACT derived type).
- if (const semantics::IntrinsicTypeSpec *
- intrinsic{typeSpec->AsIntrinsic()}) {
+ if (const semantics::IntrinsicTypeSpec *intrinsic{
+ typeSpec->AsIntrinsic()}) {
TypeCategory category{intrinsic->category()};
if (auto optKind{ToInt64(intrinsic->kind())}) {
int kind{static_cast<int>(*optKind)};
return DynamicTypeWithLength{DynamicType{category, kind}};
}
}
- } else if (const semantics::DerivedTypeSpec *
- derived{typeSpec->AsDerived()}) {
+ } else if (const semantics::DerivedTypeSpec *derived{
+ typeSpec->AsDerived()}) {
return DynamicTypeWithLength{DynamicType{*derived}};
}
}
} else if (const auto *object{
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
// C928 & C1002
- if (Triplet * last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
+ if (Triplet *last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
if (!last->upper() && object->IsAssumedSize()) {
Say("Assumed-size array '%s' must have explicit final "
"subscript upper bound value"_err_en_US,
if (auto *triplet{std::get_if<parser::SubscriptTriplet>(
&arrElement.subscripts.front().u)}) {
if (!std::get<2 /*stride*/>(triplet->t).has_value()) {
- if (const Symbol *
- symbol{parser::GetLastName(arrElement.base).symbol}) {
+ if (const Symbol *symbol{
+ parser::GetLastName(arrElement.base).symbol}) {
const Symbol &ultimate{symbol->GetUltimate()};
- if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
+ if (const semantics::DeclTypeSpec *type{ultimate.GetType()}) {
if (!ultimate.IsObjectArray() &&
type->category() == semantics::DeclTypeSpec::Character) {
// The ambiguous S(j:k) was parsed as an array section
ultimate, AsGenericExpr(TypeParamInquiry{std::nullopt, ultimate})));
} else {
if (n.symbol->attrs().test(semantics::Attr::VOLATILE)) {
- if (const semantics::Scope *
- pure{semantics::FindPureProcedureContaining(
+ if (const semantics::Scope *pure{semantics::FindPureProcedureContaining(
context_.FindScope(n.source))}) {
SayAt(n,
"VOLATILE variable '%s' may not be referenced in pure subprogram '%s'"_err_en_US,
if (ae.subscripts.empty()) {
// will be converted to function call later or error reported
} else if (baseExpr->Rank() == 0) {
- if (const Symbol * symbol{GetLastSymbol(*baseExpr)}) {
+ if (const Symbol *symbol{GetLastSymbol(*baseExpr)}) {
if (!context_.HasError(symbol)) {
if (inDataStmtConstant_) {
// Better error for NULL(X) with a MOLD= argument
if (&component.owner() == &scope) {
return Component{std::move(base), component};
}
- if (const Symbol * typeSymbol{scope.GetSymbol()}) {
- if (const Symbol *
- parentComponent{typeSymbol->GetParentComponent(&scope)}) {
+ if (const Symbol *typeSymbol{scope.GetSymbol()}) {
+ if (const Symbol *parentComponent{typeSymbol->GetParentComponent(&scope)}) {
if (const auto *object{
parentComponent->detailsIf<semantics::ObjectEntityDetails>()}) {
if (const auto *parentType{object->type()}) {
- if (const semantics::Scope *
- parentScope{parentType->derivedTypeSpec().scope()}) {
+ if (const semantics::Scope *parentScope{
+ parentType->derivedTypeSpec().scope()}) {
return CreateComponent(
DataRef{Component{std::move(base), *parentComponent}},
component, *parentScope);
if (auto *aRef{std::get_if<ArrayRef>(&dataRef->u)}) {
subscripts = std::move(aRef->subscript());
reversed.push_back(aRef->GetLastSymbol());
- if (Component * component{aRef->base().UnwrapComponent()}) {
+ if (Component *component{aRef->base().UnwrapComponent()}) {
dataRef = &component->base();
} else {
dataRef = nullptr;
auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
parser::Name structureType{std::get<parser::Name>(parsedType.t)};
parser::CharBlock &typeName{structureType.source};
- if (semantics::Symbol * typeSymbol{structureType.symbol}) {
+ if (semantics::Symbol *typeSymbol{structureType.symbol}) {
if (typeSymbol->has<semantics::DerivedTypeDetails>()) {
semantics::DerivedTypeSpec dtSpec{typeName, typeSymbol->GetUltimate()};
if (!CheckIsValidForwardReference(dtSpec)) {
} else if (symbol->has<semantics::ObjectEntityDetails>()) {
// C1594(4)
if (const auto *pureProc{FindPureProcedureContaining(innermost)}) {
- if (const Symbol * pointer{FindPointerComponent(*symbol)}) {
- if (const Symbol *
- object{FindExternallyVisibleObject(*value, *pureProc)}) {
+ if (const Symbol *pointer{FindPointerComponent(*symbol)}) {
+ if (const Symbol *object{
+ FindExternallyVisibleObject(*value, *pureProc)}) {
if (auto *msg{Say(expr.source,
"Externally visible object '%s' may not be "
"associated with pointer component '%s' in a "
static int GetPassIndex(const Symbol &proc) {
CHECK(!proc.attrs().test(semantics::Attr::NOPASS));
std::optional<parser::CharBlock> passName{GetPassName(proc)};
- const auto *interface { semantics::FindInterface(proc) };
+ const auto *interface {
+ semantics::FindInterface(proc)
+ };
if (!passName || !interface) {
return 0; // first argument is passed-object
}
bool isSubroutine) -> std::optional<CalleeAndArguments> {
const parser::StructureComponent &sc{pcr.v.thing};
if (MaybeExpr base{Analyze(sc.base)}) {
- if (const Symbol * sym{sc.component.symbol}) {
+ if (const Symbol *sym{sc.component.symbol}) {
if (context_.HasError(sym)) {
return std::nullopt;
}
if (dataRef && !CheckDataRef(*dataRef)) {
return std::nullopt;
}
- if (const Symbol *
- resolution{GetBindingResolution(dtExpr->GetType(), *sym)}) {
+ if (const Symbol *resolution{
+ GetBindingResolution(dtExpr->GetType(), *sym)}) {
AddPassArg(arguments, std::move(*dtExpr), *sym, false);
return CalleeAndArguments{
ProcedureDesignator{*resolution}, std::move(arguments)};
}
// Check parent derived type
if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
- if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
+ if (const Symbol *extended{parentScope->FindComponent(symbol.name())}) {
auto pair{ResolveGeneric(
*extended, actuals, adjustActuals, isSubroutine, false)};
if (pair.first) {
// See 15.5.5.2 for details.
if (!symbol.owner().IsGlobal() && !symbol.owner().IsDerivedType()) {
for (const std::string &n : GetAllNames(context_, symbol.name())) {
- if (const Symbol * outer{symbol.owner().parent().FindSymbol(n)}) {
+ if (const Symbol *outer{symbol.owner().parent().FindSymbol(n)}) {
auto pair{ResolveGeneric(*outer, actuals, adjustActuals, isSubroutine,
mightBeStructureConstructor)};
if (pair.first) {
}
template <>
const Symbol *AssumedTypeDummy<parser::Name>(const parser::Name &name) {
- if (const Symbol * symbol{name.symbol}) {
+ if (const Symbol *symbol{name.symbol}) {
if (const auto *type{symbol->GetType()}) {
if (type->category() == semantics::DeclTypeSpec::TypeStar) {
return symbol;
std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
parser::CharBlock callSite, const ProcedureDesignator &proc,
ActualArguments &arguments) {
+ bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
+ const Symbol *procSymbol{proc.GetSymbol()};
auto chars{characteristics::Procedure::Characterize(
proc, context_.foldingContext())};
+ bool ok{true};
if (chars) {
- bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
Say(callSite,
"References to the procedure '%s' require an explicit interface"_err_en_US,
- DEREF(proc.GetSymbol()).name());
+ DEREF(procSymbol).name());
}
// Checks for ASSOCIATED() are done in intrinsic table processing
const SpecificIntrinsic *specificIntrinsic{proc.GetSpecificIntrinsic()};
bool procIsAssociated{
specificIntrinsic && specificIntrinsic->name == "associated"};
if (!procIsAssociated) {
- const Symbol *procSymbol{proc.GetSymbol()};
bool procIsDummy{procSymbol && IsDummy(*procSymbol)};
if (chars->functionResult &&
chars->functionResult->IsAssumedLengthCharacter() &&
Say(callSite,
"Assumed-length character function must be defined with a length to be called"_err_en_US);
}
- semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
+ ok &= semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
context_.FindScope(callSite), treatExternalAsImplicit,
specificIntrinsic);
if (procSymbol && !IsPureProcedure(*procSymbol)) {
- if (const semantics::Scope *
- pure{semantics::FindPureProcedureContaining(
+ if (const semantics::Scope *pure{semantics::FindPureProcedureContaining(
context_.FindScope(callSite))}) {
Say(callSite,
"Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
}
}
}
+ if (ok && !treatExternalAsImplicit && procSymbol &&
+ !(chars && chars->HasExplicitInterface())) {
+ if (const Symbol *global{FindGlobal(*procSymbol)};
+ global && global != procSymbol && IsProcedure(*global)) {
+ // Check a known global definition behind a local interface
+ if (auto globalChars{characteristics::Procedure::Characterize(
+ *global, context_.foldingContext())}) {
+ semantics::CheckArguments(*globalChars, arguments, GetFoldingContext(),
+ context_.FindScope(callSite), true,
+ nullptr /*not specific intrinsic*/);
+ }
+ }
+ }
return chars;
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
if (MaybeExpr operand{Analyze(x.v.value())}) {
- if (const semantics::Symbol * symbol{GetLastSymbol(*operand)}) {
- if (const semantics::Symbol * result{FindFunctionResult(*symbol)}) {
+ if (const semantics::Symbol *symbol{GetLastSymbol(*operand)}) {
+ if (const semantics::Symbol *result{FindFunctionResult(*symbol)}) {
if (semantics::IsProcedurePointer(*result)) {
Say("A function reference that returns a procedure "
"pointer may not be parenthesized"_err_en_US); // C1003
// intrinsic function.
// Use the actual source for the name of the call for error reporting.
std::optional<ActualArgument> arg;
- if (const Symbol * assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
+ if (const Symbol *assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
arg = ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
} else if (MaybeExpr argExpr{Analyze(x.v.value())}) {
arg = ActualArgument{std::move(*argExpr)};
if (!name->symbol) {
return false;
} else if (name->symbol->Rank() == 0) {
- if (const Symbol *
- function{
+ if (const Symbol *function{
semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)}) {
auto &msg{context.Say(funcRef.v.source,
"Recursive call to '%s' requires a distinct RESULT in its declaration"_err_en_US,
std::get_if<common::Indirection<parser::FunctionReference>>(&u)}) {
parser::FunctionReference &funcRef{func->value()};
auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
- if (Symbol *
- origSymbol{
+ if (Symbol *origSymbol{
common::visit(common::visitors{
[&](parser::Name &name) { return name.symbol; },
[&](parser::ProcComponentRef &pcr) {
return Expr<SomeType>{NullPointer{}};
}
}
- if (const Symbol * symbol{proc.GetSymbol()}) {
+ if (const Symbol *symbol{proc.GetSymbol()}) {
if (!ResolveForward(*symbol)) {
return std::nullopt;
}
isUserOp ? std::string{opr} : "operator("s + opr + ')'};
parser::CharBlock oprName{oprNameString};
const auto &scope{context_.context().FindScope(source_)};
- if (Symbol * symbol{scope.FindSymbol(oprName)}) {
+ if (Symbol *symbol{scope.FindSymbol(oprName)}) {
*definedOpSymbolPtr = symbol;
parser::Name name{symbol->name(), symbol};
if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
}
}
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)}) {
if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
return result;
}
parser::CharBlock oprName{oprNameString};
const Symbol *proc{nullptr};
const auto &scope{context_.context().FindScope(source_)};
- if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
+ if (const Symbol *symbol{scope.FindSymbol(oprName)}) {
ExpressionAnalyzer::AdjustActuals noAdjustment;
auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true)};
if (pair.first) {
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)}) {
+ if (const Symbol *resolution{
+ GetBindingResolution(GetType(i), *specific)}) {
proc = resolution;
} else {
proc = specific;
for (const auto &actual : actuals_) {
if (!actual.has_value()) {
os << "- error\n";
- } else if (const Symbol * symbol{actual->GetAssumedTypeDummy()}) {
+ } else if (const Symbol *symbol{actual->GetAssumedTypeDummy()}) {
os << "- assumed type: " << symbol->name().ToString() << '\n';
} else if (const Expr<SomeType> *expr{actual->UnwrapExpr()}) {
expr->AsFortran(os << "- expr: ") << '\n';
std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
const parser::Expr &expr) {
source_.ExtendToCover(expr.source);
- if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
+ if (const Symbol *assumedTypeDummy{AssumedTypeDummy(expr)}) {
expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter);
if (isProcedureCall_) {
ActualArgument arg{ActualArgument::AssumedType{*assumedTypeDummy}};
details);
}
-const std::string Symbol::GetDetailsName() const {
- return DetailsToString(details_);
-}
+std::string Symbol::GetDetailsName() const { return DetailsToString(details_); }
void Symbol::set_details(Details &&details) {
CHECK(CanReplaceDetails(details));
return nullptr;
}
+const Symbol *FindGlobal(const Symbol &original) {
+ const Symbol &ultimate{original.GetUltimate()};
+ if (ultimate.owner().IsGlobal()) {
+ return &ultimate;
+ }
+ bool isLocal{false};
+ if (IsDummy(ultimate)) {
+ } else if (IsPointer(ultimate)) {
+ } else if (ultimate.has<ProcEntityDetails>()) {
+ isLocal = IsExternal(ultimate);
+ } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
+ isLocal = subp->isInterface();
+ }
+ if (isLocal) {
+ const std::string *bind{ultimate.GetBindName()};
+ if (!bind || ultimate.name() == *bind) {
+ const Scope &globalScope{ultimate.owner().context().globalScope()};
+ if (auto iter{globalScope.find(ultimate.name())};
+ iter != globalScope.end()) {
+ const Symbol &global{*iter->second};
+ const std::string *globalBind{global.GetBindName()};
+ if (!globalBind || global.name() == *globalBind) {
+ return &global;
+ }
+ }
+ }
+ }
+ return nullptr;
+}
+
const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &derived) {
return FindParentTypeSpec(derived.typeSymbol());
}
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Catch discrepancies between a local interface and a global definition
+
+subroutine global1(x)
+ integer, intent(in) :: x
+end subroutine
+
+subroutine global2(x) bind(c,name="xyz")
+ integer, intent(in) :: x
+end subroutine
+
+subroutine global3(x)
+ integer, intent(in) :: x
+end subroutine
+
+pure subroutine global4(x)
+ integer, intent(in) :: x
+end subroutine
+
+subroutine global5(x)
+ integer, intent(in) :: x
+end subroutine
+
+program test
+ interface
+ !WARNING: The global subprogram 'global1' is not compatible with its local procedure declaration (incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4))
+ subroutine global1(x)
+ real, intent(in) :: x
+ end subroutine
+ subroutine global2(x)
+ real, intent(in) :: x
+ end subroutine
+ subroutine global3(x) bind(c,name="abc")
+ real, intent(in) :: x
+ end subroutine
+ subroutine global4(x) ! not PURE, but that's ok
+ integer, intent(in) :: x
+ end subroutine
+ !WARNING: The global subprogram 'global5' is not compatible with its local procedure declaration (incompatible procedure attributes: Pure)
+ pure subroutine global5(x)
+ integer, intent(in) :: x
+ end subroutine
+ end interface
+end
+
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+module module_before_1
+end
+
+module module_before_2
+end
+
+block data block_data_before_1
+end
+
+block data block_data_before_2
+end
+
+subroutine explicit_before_1(a)
+ real, optional :: a
+end
+
+subroutine explicit_before_2(a)
+ real, optional :: a
+end
+
+subroutine implicit_before_1(a)
+ real :: a
+end
+
+subroutine implicit_before_2(a)
+ real :: a
+end
+
+function explicit_func_before_1(a)
+ real, optional :: a
+end
+
+function explicit_func_before_2(a)
+ real, optional :: a
+end
+
+function implicit_func_before_1(a)
+ real :: a
+end
+
+function implicit_func_before_2(a)
+ real :: a
+end
+
+program test
+ external justfine ! OK to name a BLOCK DATA if not called
+ !ERROR: The global entity 'module_before_1' corresponding to the local procedure 'module_before_1' is not a callable subprogram
+ external module_before_1
+ !ERROR: The global entity 'block_data_before_1' corresponding to the local procedure 'block_data_before_1' is not a callable subprogram
+ external block_data_before_1
+ !ERROR: The global subprogram 'explicit_before_1' may not be referenced via the implicit interface 'explicit_before_1'
+ external explicit_before_1
+ external implicit_before_1
+ !ERROR: The global subprogram 'explicit_func_before_1' may not be referenced via the implicit interface 'explicit_func_before_1'
+ external explicit_func_before_1
+ external implicit_func_before_1
+ !ERROR: The global entity 'module_after_1' corresponding to the local procedure 'module_after_1' is not a callable subprogram
+ external module_after_1
+ !ERROR: The global entity 'block_data_after_1' corresponding to the local procedure 'block_data_after_1' is not a callable subprogram
+ external block_data_after_1
+ !ERROR: The global subprogram 'explicit_after_1' may not be referenced via the implicit interface 'explicit_after_1'
+ external explicit_after_1
+ external implicit_after_1
+ !ERROR: The global subprogram 'explicit_func_after_1' may not be referenced via the implicit interface 'explicit_func_after_1'
+ external explicit_func_after_1
+ external implicit_func_after_1
+ call module_before_1
+ !ERROR: 'module_before_2' is not a callable procedure
+ call module_before_2
+ call block_data_before_1
+ !ERROR: 'block_data_before_2' is not a callable procedure
+ call block_data_before_2
+ call explicit_before_1(1.)
+ !ERROR: References to the procedure 'explicit_before_2' require an explicit interface
+ call explicit_before_2(1.)
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ call implicit_before_1
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ call implicit_before_2
+ print *, explicit_func_before_1(1.)
+ !ERROR: References to the procedure 'explicit_func_before_2' require an explicit interface
+ print *, explicit_func_before_2(1.)
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ print *, implicit_func_before_1()
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ print *, implicit_func_before_2()
+ call module_after_1
+ call module_after_2
+ call block_data_after_1
+ call block_data_after_2
+ call explicit_after_1(1.)
+ !ERROR: References to the procedure 'explicit_after_2' require an explicit interface
+ call explicit_after_2(1.)
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ call implicit_after_1
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ call implicit_after_2
+ print *, explicit_func_after_1(1.)
+ !ERROR: References to the procedure 'explicit_func_after_2' require an explicit interface
+ print *, explicit_func_after_2(1.)
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ print *, implicit_func_after_1()
+ !WARNING: If the procedure's interface were explicit, this reference would be in error
+ !BECAUSE: Dummy argument 'a=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
+ print *, implicit_func_after_2()
+end program
+
+block data justfine
+end
+
+module module_after_1
+end
+
+!ERROR: 'module_after_2' is already declared in this scoping unit
+module module_after_2
+end
+
+block data block_data_after_1
+end
+
+!ERROR: BLOCK DATA 'block_data_after_2' has been called
+block data block_data_after_2
+end
+
+subroutine explicit_after_1(a)
+ real, optional :: a
+end
+
+subroutine explicit_after_2(a)
+ real, optional :: a
+end
+
+subroutine implicit_after_1(a)
+ real :: a
+end
+
+subroutine implicit_after_2(a)
+ real :: a
+end
+
+function explicit_func_after_1(a)
+ real, optional :: a
+end
+
+function explicit_func_after_2(a)
+ real, optional :: a
+end
+
+function implicit_func_after_1(a)
+ real :: a
+end
+
+function implicit_func_after_2(a)
+ real :: a
+end
end function nested5
end module module1
-!DEF: /explicit1 ELEMENTAL (Function) Subprogram REAL(4)
+!DEF: /explicit1 (Function) Subprogram REAL(4)
!DEF: /explicit1/x INTENT(IN) ObjectEntity REAL(4)
-real elemental function explicit1(x)
+real function explicit1(x)
!REF: /explicit1/x
real, intent(in) :: x
!DEF: /explicit1/explicit1 ObjectEntity REAL(4)
logical = x+3.
end function logical
-!DEF: /tan (Function) Subprogram REAL(4)
+!DEF: /tan (Function) Subprogram CHARACTER(1_8,1)
!DEF: /tan/x INTENT(IN) ObjectEntity REAL(4)
-real function tan(x)
+character*1 function tan(x)
!REF: /tan/x
real, intent(in) :: x
- !DEF: /tan/tan ObjectEntity REAL(4)
- !REF: /tan/x
- tan = x+5.
+ !DEF: /tan/tan ObjectEntity CHARACTER(1_8,1)
+ tan = "?"
end function tan
!DEF: /main MainProgram
!ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: 'p', 'sub', 'p2'
procedure(sub) :: p
interface
+ !ERROR: Procedure 'sub' is recursively defined. Procedures in the cycle: 'p', 'sub', 'p2'
subroutine sub(p2)
import p
procedure(p) :: p2
end subroutine
end interface
end
-
! Two procedures that differ only by attributes are not distinguishable
module m8
end interface
end module
-subroutine s1()
+subroutine subr1()
use m20
interface operator(.not.)
!ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
!ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
procedure f
end interface
-end subroutine s1
+end subroutine subr1
! Extensions for distinguishable allocatable arguments; these should not
! elicit errors from f18
! RUN: %python %S/test_errors.py %s %flang_fc1
! Resolve generic based on number of arguments
-subroutine s1
+subroutine subr1
interface f
real function f1(x)
optional :: x
end
! Elemental and non-element function both match: non-elemental one should be used
-subroutine s2
+subroutine subr2
interface f
logical elemental function f1(x)
intent(in) :: x
real, protected :: x
real :: y
interface s
- pure subroutine s1(x)
+ pure subroutine s101(x)
real, intent(out) :: x
end
- subroutine s2(x, y)
+ subroutine s102(x, y)
real :: x, y
end
end interface
projects / platform / upstream / llvm.git / commitdiff