[flang-commits] [flang] [flang] Whether a procedure's interface is explicit or not is not a d… (PR #82796)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Feb 29 09:57:35 PST 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/82796
>From 69f189193f44f51e407484a1b77ab68b91ece199 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 23 Feb 2024 09:16:27 -0800
Subject: [PATCH] [flang] Whether a procedure's interface is explicit or not is
not a distinguishing characteristic
We note whether a procedure's interface is explicit or implicit as an
attribute of its characteristics, so that other semantics can be
checked appropriately, but this internal attribute should not be
used as a distinguishing characteristic in itself.
Fixes https://github.com/llvm/llvm-project/issues/81876.
---
.../include/flang/Evaluate/characteristics.h | 4 ++--
flang/lib/Evaluate/characteristics.cpp | 12 ++++++++---
flang/lib/Evaluate/tools.cpp | 3 ++-
flang/lib/Semantics/check-call.cpp | 3 ++-
flang/lib/Semantics/check-declarations.cpp | 6 ++++--
flang/lib/Semantics/expression.cpp | 3 ++-
flang/lib/Semantics/resolve-names.cpp | 21 +++++++++++++------
7 files changed, 36 insertions(+), 16 deletions(-)
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 04a0d71e1adebe..f2f37866ecde86 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -381,8 +381,8 @@ struct Procedure {
int FindPassIndex(std::optional<parser::CharBlock>) const;
bool CanBeCalledViaImplicitInterface(std::string *whyNot = nullptr) const;
bool CanOverride(const Procedure &, std::optional<int> passIndex) const;
- bool IsCompatibleWith(const Procedure &, std::string *whyNot = nullptr,
- const SpecificIntrinsic * = nullptr,
+ bool IsCompatibleWith(const Procedure &, bool ignoreImplicitVsExplicit,
+ std::string *whyNot = nullptr, const SpecificIntrinsic * = nullptr,
std::optional<std::string> *warning = nullptr) const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 80b0f346c32d38..ee556a1053713e 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -533,7 +533,8 @@ bool DummyProcedure::IsCompatibleWith(
}
return false;
}
- if (!procedure.value().IsCompatibleWith(actual.procedure.value(), whyNot)) {
+ if (!procedure.value().IsCompatibleWith(actual.procedure.value(),
+ /*ignoreImplicitVsExplicit=*/false, whyNot)) {
if (whyNot) {
*whyNot = "incompatible dummy procedure interfaces: "s + *whyNot;
}
@@ -1206,7 +1207,8 @@ bool FunctionResult::IsCompatibleWith(
CHECK(ifaceProc != nullptr);
if (const auto *actualProc{
std::get_if<CopyableIndirection<Procedure>>(&actual.u)}) {
- if (ifaceProc->value().IsCompatibleWith(actualProc->value(), whyNot)) {
+ if (ifaceProc->value().IsCompatibleWith(actualProc->value(),
+ /*ignoreImplicitVsExplicit=*/false, whyNot)) {
return true;
}
if (whyNot) {
@@ -1251,7 +1253,8 @@ bool Procedure::operator==(const Procedure &that) const {
cudaSubprogramAttrs == that.cudaSubprogramAttrs;
}
-bool Procedure::IsCompatibleWith(const Procedure &actual, std::string *whyNot,
+bool Procedure::IsCompatibleWith(const Procedure &actual,
+ bool ignoreImplicitVsExplicit, std::string *whyNot,
const SpecificIntrinsic *specificIntrinsic,
std::optional<std::string> *warning) const {
// 15.5.2.9(1): if dummy is not pure, actual need not be.
@@ -1265,6 +1268,9 @@ bool Procedure::IsCompatibleWith(const Procedure &actual, std::string *whyNot,
}
Attrs differences{attrs ^ actualAttrs};
differences.reset(Attr::Subroutine); // dealt with specifically later
+ if (ignoreImplicitVsExplicit) {
+ differences.reset(Attr::ImplicitInterface);
+ }
if (!differences.empty()) {
if (whyNot) {
auto sep{": "s};
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 131bbd97ce1632..f1de4213ff2f1a 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1097,7 +1097,8 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
*rhsProcedure->functionResult, &whyNotCompatible)) {
msg =
"Function %s associated with incompatible function designator '%s': %s"_err_en_US;
- } else if (lhsProcedure->IsCompatibleWith(*rhsProcedure, &whyNotCompatible,
+ } else if (lhsProcedure->IsCompatibleWith(*rhsProcedure,
+ /*ignoreImplictVsExplicit=*/true, &whyNotCompatible,
specificIntrinsic, &warning)) {
// OK
} else if (isCall) {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index fdf7805beab7ed..569772e515f02b 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -975,7 +975,8 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
if (interface.HasExplicitInterface()) {
std::string whyNot;
std::optional<std::string> warning;
- if (!interface.IsCompatibleWith(argInterface, &whyNot,
+ if (!interface.IsCompatibleWith(argInterface,
+ /*ignoreImplicitVsExplicit=*/true, &whyNot,
/*specificIntrinsic=*/nullptr, &warning)) {
// 15.5.2.9(1): Explicit interfaces must match
if (argInterface.HasExplicitInterface()) {
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index e9adc086402d63..719bea34406aa0 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1481,7 +1481,8 @@ void CheckHelper::CheckExternal(const Symbol &symbol) {
if (auto globalChars{Characterize(*global)}) {
if (chars->HasExplicitInterface()) {
std::string whyNot;
- if (!chars->IsCompatibleWith(*globalChars, &whyNot)) {
+ if (!chars->IsCompatibleWith(*globalChars,
+ /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
msg = WarnIfNotInModuleFile(
"The global subprogram '%s' is not compatible with its local procedure declaration (%s)"_warn_en_US,
global->name(), whyNot);
@@ -1507,7 +1508,8 @@ void CheckHelper::CheckExternal(const Symbol &symbol) {
if (auto chars{Characterize(symbol)}) {
if (auto previousChars{Characterize(previous)}) {
std::string whyNot;
- if (!chars->IsCompatibleWith(*previousChars, &whyNot)) {
+ if (!chars->IsCompatibleWith(*previousChars,
+ /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
if (auto *msg{WarnIfNotInModuleFile(
"The external interface '%s' is not compatible with an earlier definition (%s)"_warn_en_US,
symbol.name(), whyNot)}) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8d817f077880b9..5398b0f30abd41 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3129,7 +3129,8 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
if (auto iter{implicitInterfaces_.find(name)};
iter != implicitInterfaces_.end()) {
std::string whyNot;
- if (!chars->IsCompatibleWith(iter->second.second, &whyNot)) {
+ if (!chars->IsCompatibleWith(iter->second.second,
+ /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
if (auto *msg{Say(callSite,
"Reference to the procedure '%s' has an implicit interface that is distinct from another reference: %s"_warn_en_US,
name, whyNot)}) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 0cbe0b492fa44a..5389456d0f4913 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -8362,16 +8362,25 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
const auto &expr{std::get<parser::Expr>(x.t)};
ResolveDataRef(dataRef);
+ Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};
Walk(bounds);
// Resolve unrestricted specific intrinsic procedures as in "p => cos".
if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
if (NameIsKnownOrIntrinsic(*name)) {
- // If the name is known because it is an object entity from a host
- // procedure, create a host associated symbol.
- if (Symbol * symbol{name->symbol}; symbol &&
- symbol->GetUltimate().has<ObjectEntityDetails>() &&
- IsUplevelReference(*symbol)) {
- MakeHostAssocSymbol(*name, *symbol);
+ if (Symbol * symbol{name->symbol}) {
+ if (IsProcedurePointer(ptrSymbol) &&
+ !ptrSymbol->test(Symbol::Flag::Function) &&
+ !ptrSymbol->test(Symbol::Flag::Subroutine)) {
+ if (symbol->test(Symbol::Flag::Function)) {
+ ApplyImplicitRules(*ptrSymbol);
+ }
+ }
+ // If the name is known because it is an object entity from a host
+ // procedure, create a host associated symbol.
+ if (symbol->GetUltimate().has<ObjectEntityDetails>() &&
+ IsUplevelReference(*symbol)) {
+ MakeHostAssocSymbol(*name, *symbol);
+ }
}
return false;
}
More information about the flang-commits
mailing list