[flang-commits] [flang] bdbebef - [flang] Warn about inconsistent implicit interfaces
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Mar 2 15:16:26 PST 2023
Author: Peter Klausler
Date: 2023-03-02T15:16:13-08:00
New Revision: bdbebef828da330c7bfb8809a2e993289fbe7e57
URL: https://github.com/llvm/llvm-project/commit/bdbebef828da330c7bfb8809a2e993289fbe7e57
DIFF: https://github.com/llvm/llvm-project/commit/bdbebef828da330c7bfb8809a2e993289fbe7e57.diff
LOG: [flang] Warn about inconsistent implicit interfaces
When a global procedure has no explicit interface, emit warnings
when its references are inconsistent implicit procedure interfaces.
Differential Revision: https://reviews.llvm.org/D145097
Added:
flang/test/Semantics/call35.f90
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/include/flang/Semantics/expression.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Semantics/expression.cpp
flang/test/Semantics/bad-forward-type.f90
flang/test/Semantics/reshape.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 29bf0e92dc40..b6447135084f 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -259,6 +259,8 @@ struct DummyArgument {
bool operator!=(const DummyArgument &that) const { return !(*this == that); }
static std::optional<DummyArgument> FromActual(
std::string &&, const Expr<SomeType> &, FoldingContext &);
+ static std::optional<DummyArgument> FromActual(
+ std::string &&, const ActualArgument &, FoldingContext &);
bool IsOptional() const;
void SetOptional(bool = true);
common::Intent GetIntent() const;
@@ -338,6 +340,10 @@ struct Procedure {
const ProcedureDesignator &, FoldingContext &);
static std::optional<Procedure> Characterize(
const ProcedureRef &, FoldingContext &);
+ // Characterizes the procedure being referenced, deducing dummy argument
+ // types from actual arguments in the case of an implicit interface.
+ static std::optional<Procedure> FromActuals(
+ const ProcedureDesignator &, const ActualArguments &, FoldingContext &);
// At most one of these will return true.
// For "EXTERNAL P" with no type for or calls to P, both will be false.
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index e8c313b9b9f3..8ae93d364bfd 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -386,6 +386,9 @@ class ExpressionAnalyzer {
semantics::SemanticsContext &context_;
FoldingContext &foldingContext_{context_.foldingContext()};
std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
+ std::map<parser::CharBlock,
+ std::pair<parser::CharBlock, evaluate::characteristics::Procedure>>
+ implicitInterfaces_;
bool isWholeAssumedSizeArrayOk_{false};
bool isNullPointerOk_{false};
bool useSavedTypedExprs_{true};
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index bed45fa0e570..0fe965aeab12 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -724,6 +724,17 @@ std::optional<DummyArgument> DummyArgument::FromActual(
expr.u);
}
+std::optional<DummyArgument> DummyArgument::FromActual(
+ std::string &&name, const ActualArgument &arg, FoldingContext &context) {
+ if (const auto *expr{arg.UnwrapExpr()}) {
+ return FromActual(std::move(name), *expr, context);
+ } else if (arg.GetAssumedTypeDummy()) {
+ return std::nullopt;
+ } else {
+ return DummyArgument{AlternateReturn{}};
+ }
+}
+
bool DummyArgument::IsOptional() const {
return common::visit(
common::visitors{
@@ -1132,6 +1143,30 @@ std::optional<Procedure> Procedure::Characterize(
return std::nullopt;
}
+std::optional<Procedure> Procedure::FromActuals(const ProcedureDesignator &proc,
+ const ActualArguments &args, FoldingContext &context) {
+ auto callee{Characterize(proc, context)};
+ if (callee) {
+ if (callee->dummyArguments.empty() &&
+ callee->attrs.test(Procedure::Attr::ImplicitInterface)) {
+ int j{0};
+ for (const auto &arg : args) {
+ ++j;
+ if (arg) {
+ if (auto dummy{DummyArgument::FromActual(
+ "x"s + std::to_string(j), *arg, context)}) {
+ callee->dummyArguments.emplace_back(std::move(*dummy));
+ continue;
+ }
+ }
+ callee.reset();
+ break;
+ }
+ }
+ }
+ return callee;
+}
+
bool Procedure::CanBeCalledViaImplicitInterface() const {
// TODO: Pass back information on why we return false
if (attrs.test(Attr::Elemental) || attrs.test(Attr::BindC)) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 62f70f1c5bf6..b5f3a07679fd 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2877,8 +2877,38 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
ActualArguments &arguments) {
bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
const Symbol *procSymbol{proc.GetSymbol()};
- auto chars{characteristics::Procedure::Characterize(
- proc, context_.foldingContext())};
+ std::optional<characteristics::Procedure> chars;
+ if (procSymbol && procSymbol->has<semantics::ProcEntityDetails>() &&
+ procSymbol->owner().IsGlobal()) {
+ // Unknown global external, implicit interface; assume
+ // characteristics from the actual arguments, and check
+ // for consistency with other references.
+ chars = characteristics::Procedure::FromActuals(
+ proc, arguments, context_.foldingContext());
+ if (chars && procSymbol) {
+ // Ensure calls over implicit interfaces are consistent
+ auto name{procSymbol->name()};
+ if (auto iter{implicitInterfaces_.find(name)};
+ iter != implicitInterfaces_.end()) {
+ std::string whyNot;
+ if (!chars->IsCompatibleWith(iter->second.second, &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)}) {
+ msg->Attach(
+ iter->second.first, "previous reference to '%s'"_en_US, name);
+ }
+ }
+ } else {
+ implicitInterfaces_.insert(
+ std::make_pair(name, std::make_pair(callSite, *chars)));
+ }
+ }
+ }
+ if (!chars) {
+ chars = characteristics::Procedure::Characterize(
+ proc, context_.foldingContext());
+ }
bool ok{true};
if (chars) {
if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
diff --git a/flang/test/Semantics/bad-forward-type.f90 b/flang/test/Semantics/bad-forward-type.f90
index f7230d101d7e..19e23e654642 100644
--- a/flang/test/Semantics/bad-forward-type.f90
+++ b/flang/test/Semantics/bad-forward-type.f90
@@ -5,22 +5,22 @@
!ERROR: The derived type 'undef' was forward-referenced but not defined
type(undef) function f1()
- call sub(f1)
+ call sub1(f1)
end function
!ERROR: The derived type 'undef' was forward-referenced but not defined
type(undef) function f2() result(r)
- call sub(r)
+ call sub2(r)
end function
!ERROR: The derived type 'undefpdt' was forward-referenced but not defined
type(undefpdt(1)) function f3()
- call sub(f3)
+ call sub3(f3)
end function
!ERROR: The derived type 'undefpdt' was forward-referenced but not defined
type(undefpdt(1)) function f4() result(r)
- call sub(f4)
+ call sub4(f4)
end function
!ERROR: 'bad' is not the name of a parameter for derived type 'pdt'
diff --git a/flang/test/Semantics/call35.f90 b/flang/test/Semantics/call35.f90
new file mode 100644
index 000000000000..ddcd64cec6c4
--- /dev/null
+++ b/flang/test/Semantics/call35.f90
@@ -0,0 +1,21 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+subroutine s1
+ call ext(1, 2)
+end
+
+subroutine s2
+ !WARNING: Reference to the procedure 'ext' has an implicit interface that is distinct from another reference: distinct numbers of dummy arguments
+ call ext(1.)
+end
+
+subroutine s3
+ interface
+ !WARNING: The global subprogram 'ext' is not compatible with its local procedure declaration (incompatible procedure attributes: ImplicitInterface)
+ subroutine ext(n)
+ integer n
+ end
+ end interface
+ call ext(3)
+ !ERROR: Actual argument type 'REAL(4)' is not compatible with dummy argument type 'INTEGER(4)'
+ call ext(4.)
+end
diff --git a/flang/test/Semantics/reshape.f90 b/flang/test/Semantics/reshape.f90
index 31071332f50f..2e9b5adf3ff0 100644
--- a/flang/test/Semantics/reshape.f90
+++ b/flang/test/Semantics/reshape.f90
@@ -47,6 +47,7 @@ program reshaper
!ERROR: Size of 'shape=' argument must not be greater than 15
CALL ext_sub(RESHAPE([(n, n=1,20)], &
[1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]))
+ !WARNING: Reference to the procedure 'ext_sub' has an implicit interface that is distinct from another reference: incompatible dummy argument #1: incompatible dummy data object shapes
!ERROR: 'shape=' argument must not have a negative extent
CALL ext_sub(RESHAPE([(n, n=1,20)], [1, -5, 3]))
!ERROR: 'order=' argument has unacceptable rank 2
More information about the flang-commits
mailing list