summaryrefslogtreecommitdiff
path: root/flang/lib/Semantics/resolve-names.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Semantics/resolve-names.cpp')
-rw-r--r--flang/lib/Semantics/resolve-names.cpp92
1 files changed, 66 insertions, 26 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5808b4b3cc4f..077bee930675 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -488,6 +488,10 @@ public:
// Result symbol
Symbol *resultSymbol{nullptr};
bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt
+ // Functions with previous implicitly-typed references get those types
+ // checked against their later definitions.
+ const DeclTypeSpec *previousImplicitType{nullptr};
+ SourceName previousName;
};
// Completes the definition of the top function's result.
@@ -642,12 +646,18 @@ public:
}
if (symbol->CanReplaceDetails(details)) {
// update the existing symbol
- CheckDuplicatedAttrs(name, *symbol, attrs);
- SetExplicitAttrs(*symbol, attrs);
if constexpr (std::is_same_v<SubprogramDetails, D>) {
// Dummy argument defined by explicit interface?
details.set_isDummy(IsDummy(*symbol));
+ if (symbol->has<ProcEntityDetails>()) {
+ // Bare "EXTERNAL" dummy replaced with explicit INTERFACE
+ context().Warn(common::LanguageFeature::RedundantAttribute, name,
+ "Dummy argument '%s' was declared earlier as EXTERNAL"_warn_en_US,
+ name);
+ }
}
+ CheckDuplicatedAttrs(name, *symbol, attrs);
+ SetExplicitAttrs(*symbol, attrs);
symbol->set_details(std::move(details));
return *symbol;
} else if constexpr (std::is_same_v<UnknownDetails, D>) {
@@ -943,7 +953,7 @@ private:
// Edits an existing symbol created for earlier calls to a subprogram or ENTRY
// so that it can be replaced by a later definition.
bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
- void CheckExtantProc(const parser::Name &, Symbol::Flag);
+ const Symbol *CheckExtantProc(const parser::Name &, Symbol::Flag);
// Create a subprogram symbol in the current scope and push a new scope.
Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
const parser::LanguageBindingSpec * = nullptr,
@@ -1466,7 +1476,7 @@ class OmpVisitor : public virtual DeclarationVisitor {
public:
void AddOmpSourceRange(const parser::CharBlock &);
- static bool NeedsScope(const parser::OpenMPBlockConstruct &);
+ static bool NeedsScope(const parser::OmpBlockConstruct &);
static bool NeedsScope(const parser::OmpClause &);
bool Pre(const parser::OmpMetadirectiveDirective &x) { //
@@ -1483,8 +1493,8 @@ public:
AddOmpSourceRange(x.source);
return true;
}
- bool Pre(const parser::OpenMPBlockConstruct &);
- void Post(const parser::OpenMPBlockConstruct &);
+ bool Pre(const parser::OmpBlockConstruct &);
+ void Post(const parser::OmpBlockConstruct &);
bool Pre(const parser::OmpBeginDirective &x) {
AddOmpSourceRange(x.source);
// Manually resolve names in CRITICAL directives. This is because these
@@ -1729,7 +1739,7 @@ private:
const parser::OmpMetadirectiveDirective *metaDirective_{nullptr};
};
-bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
+bool OmpVisitor::NeedsScope(const parser::OmpBlockConstruct &x) {
switch (x.BeginDir().DirId()) {
case llvm::omp::Directive::OMPD_master:
case llvm::omp::Directive::OMPD_ordered:
@@ -1750,14 +1760,14 @@ void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
currScope().AddSourceRange(source);
}
-bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
+bool OmpVisitor::Pre(const parser::OmpBlockConstruct &x) {
if (NeedsScope(x)) {
PushScope(Scope::Kind::OtherConstruct, nullptr);
}
return true;
}
-void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
+void OmpVisitor::Post(const parser::OmpBlockConstruct &x) {
if (NeedsScope(x)) {
PopScope();
}
@@ -2691,11 +2701,24 @@ void ArraySpecVisitor::PostAttrSpec() {
FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
+// True when either type is absent, or if they are both present and are
+// equivalent for interface compatibility purposes.
+static bool TypesMismatchIfNonNull(
+ const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
+ if (auto t1{evaluate::DynamicType::From(type1)}) {
+ if (auto t2{evaluate::DynamicType::From(type2)}) {
+ return !t1->IsEquivalentTo(*t2);
+ }
+ }
+ return false;
+}
+
void FuncResultStack::CompleteFunctionResultType() {
// If the function has a type in the prefix, process it now.
FuncInfo *info{Top()};
- if (info && &info->scope == &scopeHandler_.currScope()) {
- if (info->parsedType && info->resultSymbol) {
+ if (info && &info->scope == &scopeHandler_.currScope() &&
+ info->resultSymbol) {
+ if (info->parsedType) {
scopeHandler_.messageHandler().set_currStmtSource(info->source);
if (const auto *type{
scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
@@ -2712,6 +2735,16 @@ void FuncResultStack::CompleteFunctionResultType() {
}
info->parsedType = nullptr;
}
+ if (TypesMismatchIfNonNull(
+ info->resultSymbol->GetType(), info->previousImplicitType)) {
+ scopeHandler_
+ .Say(info->resultSymbol->name(),
+ "Function '%s' has a result type that differs from the implicit type it obtained in a previous reference"_err_en_US,
+ info->previousName)
+ .Attach(info->previousName,
+ "Previous reference implicitly typed as %s\n"_en_US,
+ info->previousImplicitType->AsFortran());
+ }
}
}
@@ -4761,9 +4794,7 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
if (info.resultName && !distinctResultName) {
context().Warn(common::UsageWarning::HomonymousResult,
info.resultName->source,
- "The function name should not appear in RESULT; references to '%s' "
- "inside the function will be considered as references to the "
- "result only"_warn_en_US,
+ "The function name should not appear in RESULT; references to '%s' inside the function will be considered as references to the result only"_warn_en_US,
name.source);
// RESULT name was ignored above, the only side effect from doing so will be
// the inability to make recursive calls. The related parser::Name is still
@@ -5074,8 +5105,7 @@ bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
if (hasModulePrefix && !currScope().IsModule() &&
!currScope().IsSubmodule()) { // C1547
Say(name,
- "'%s' is a MODULE procedure which must be declared within a "
- "MODULE or SUBMODULE"_err_en_US);
+ "'%s' is a MODULE procedure which must be declared within a MODULE or SUBMODULE"_err_en_US);
// Don't return here because it can be useful to have the scope set for
// other semantic checks run before we print the errors
isValid = false;
@@ -5196,9 +5226,10 @@ bool SubprogramVisitor::HandlePreviousCalls(
}
}
-void SubprogramVisitor::CheckExtantProc(
+const Symbol *SubprogramVisitor::CheckExtantProc(
const parser::Name &name, Symbol::Flag subpFlag) {
- if (auto *prev{FindSymbol(name)}) {
+ Symbol *prev{FindSymbol(name)};
+ if (prev) {
if (IsDummy(*prev)) {
} else if (auto *entity{prev->detailsIf<EntityDetails>()};
IsPointer(*prev) && entity && !entity->type()) {
@@ -5210,12 +5241,15 @@ void SubprogramVisitor::CheckExtantProc(
SayAlreadyDeclared(name, *prev);
}
}
+ return prev;
}
Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
bool hasModulePrefix) {
Symbol *symbol{GetSpecificFromGeneric(name)};
+ const DeclTypeSpec *previousImplicitType{nullptr};
+ SourceName previousName;
if (!symbol) {
if (bindingSpec && currScope().IsGlobal() &&
std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
@@ -5228,14 +5262,25 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
&MakeSymbol(context().GetTempName(currScope()), Attrs{},
MiscDetails{MiscDetails::Kind::ScopeName}));
}
- CheckExtantProc(name, subpFlag);
+ if (const Symbol *previous{CheckExtantProc(name, subpFlag)}) {
+ if (previous->test(Symbol::Flag::Function) &&
+ previous->test(Symbol::Flag::Implicit)) {
+ // Function was implicitly typed in previous compilation unit.
+ previousImplicitType = previous->GetType();
+ previousName = previous->name();
+ }
+ }
symbol = &MakeSymbol(name, SubprogramDetails{});
}
symbol->ReplaceName(name.source);
symbol->set(subpFlag);
PushScope(Scope::Kind::Subprogram, symbol);
if (subpFlag == Symbol::Flag::Function) {
- funcResultStack().Push(currScope(), name.source);
+ auto &funcResultTop{funcResultStack().Push(currScope(), name.source)};
+ funcResultTop.previousImplicitType = previousImplicitType;
+ ;
+ funcResultTop.previousName = previousName;
+ ;
}
if (inInterfaceBlock()) {
auto &details{symbol->get<SubprogramDetails>()};
@@ -7913,7 +7958,7 @@ void ConstructVisitor::Post(const parser::AssociateStmt &x) {
if (ExtractCoarrayRef(expr)) { // C1103
Say("Selector must not be a coindexed object"_err_en_US);
}
- if (evaluate::IsAssumedRank(expr)) {
+ if (IsAssumedRank(expr)) {
Say("Selector must not be assumed-rank"_err_en_US);
}
SetTypeFromAssociation(*symbol);
@@ -8669,11 +8714,6 @@ const parser::Name *DeclarationVisitor::ResolveDataRef(
x.u);
}
-static bool TypesMismatchIfNonNull(
- const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
- return type1 && type2 && *type1 != *type2;
-}
-
// If implicit types are allowed, ensure name is in the symbol table.
// Otherwise, report an error if it hasn't been declared.
const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-31 19:46:28 +0000