[flang-commits] [flang] [flang] Tune warning about incompatible implicit interfaces (PR #136788)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Apr 22 16:43:37 PDT 2025
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/136788
>From 8976d21bcf4abc7e67ec6e8b4b04665d39103173 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 22 Apr 2025 16:34:32 -0700
Subject: [PATCH] [flang] Tune warning about incompatible implicit interfaces
The compiler was emitting a warning about incompatible shapes
being used for two calls to the same procedure with an implicit
interface when one passed a whole array and the other passed
a scalar. When the scalar is a whole element of a contiguous
array, however, we must allow for storage association and not flag
it as being a problem.
---
.../include/flang/Evaluate/characteristics.h | 10 +++-
flang/include/flang/Evaluate/tools.h | 20 +++----
flang/lib/Evaluate/characteristics.cpp | 58 ++++++++++++++++---
flang/test/Semantics/call43.f90 | 17 ++++++
4 files changed, 85 insertions(+), 20 deletions(-)
create mode 100644 flang/test/Semantics/call43.f90
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 6d29b57889681..d566c34ff71e8 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -174,6 +174,14 @@ class TypeAndShape {
}
const std::optional<Shape> &shape() const { return shape_; }
const Attrs &attrs() const { return attrs_; }
+ Attrs &attrs() { return attrs_; }
+ bool isPossibleSequenceAssociation() const {
+ return isPossibleSequenceAssociation_;
+ }
+ TypeAndShape &set_isPossibleSequenceAssociation(bool yes) {
+ isPossibleSequenceAssociation_ = yes;
+ return *this;
+ }
int corank() const { return corank_; }
void set_corank(int n) { corank_ = n; }
@@ -209,11 +217,11 @@ class TypeAndShape {
void AcquireLEN();
void AcquireLEN(const semantics::Symbol &);
-protected:
DynamicType type_;
std::optional<Expr<SubscriptInteger>> LEN_;
std::optional<Shape> shape_;
Attrs attrs_;
+ bool isPossibleSequenceAssociation_{false};
int corank_{0};
};
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 1414eaf14f7d6..f9c2c2028cf27 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -386,11 +386,11 @@ std::optional<DataRef> ExtractDataRef(
std::optional<DataRef> ExtractDataRef(const ActualArgument &,
bool intoSubstring = false, bool intoComplexPart = false);
-// Predicate: is an expression is an array element reference?
-template <typename T>
-bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
- bool skipComponents = false) {
- if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
+// Predicate: is an expression or designator an array element reference?
+template <typename A>
+const Symbol *IsArrayElement(
+ const A &x, bool intoSubstring = true, bool skipComponents = false) {
+ if (auto dataRef{ExtractDataRef(x, intoSubstring)}) {
const DataRef *ref{&*dataRef};
if (skipComponents) {
while (const Component * component{std::get_if<Component>(&ref->u)}) {
@@ -398,13 +398,13 @@ bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
}
}
if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
- return !coarrayRef->subscript().empty();
- } else {
- return std::holds_alternative<ArrayRef>(ref->u);
+ return coarrayRef->subscript().empty() ? nullptr
+ : &coarrayRef->GetLastSymbol();
+ } else if (const auto *arrayRef{std::get_if<ArrayRef>(&ref->u)}) {
+ return &arrayRef->GetLastSymbol();
}
- } else {
- return false;
}
+ return nullptr;
}
template <typename A>
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 63040feae43fc..89547733ea33c 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -274,6 +274,9 @@ llvm::raw_ostream &TypeAndShape::Dump(llvm::raw_ostream &o) const {
}
o << ')';
}
+ if (isPossibleSequenceAssociation_) {
+ o << " isPossibleSequenceAssociation";
+ }
return o;
}
@@ -282,17 +285,26 @@ bool DummyDataObject::operator==(const DummyDataObject &that) const {
coshape == that.coshape && cudaDataAttr == that.cudaDataAttr;
}
+static bool IsOkWithSequenceAssociation(
+ const TypeAndShape &t1, const TypeAndShape &t2) {
+ return t1.isPossibleSequenceAssociation() &&
+ (t2.isPossibleSequenceAssociation() || t2.CanBeSequenceAssociated());
+}
+
bool DummyDataObject::IsCompatibleWith(const DummyDataObject &actual,
std::string *whyNot, std::optional<std::string> *warning) const {
- bool possibleWarning{false};
- if (!ShapesAreCompatible(
- type.shape(), actual.type.shape(), &possibleWarning)) {
- if (whyNot) {
- *whyNot = "incompatible dummy data object shapes";
+ if (!IsOkWithSequenceAssociation(type, actual.type) &&
+ !IsOkWithSequenceAssociation(actual.type, type)) {
+ bool possibleWarning{false};
+ if (!ShapesAreCompatible(
+ type.shape(), actual.type.shape(), &possibleWarning)) {
+ if (whyNot) {
+ *whyNot = "incompatible dummy data object shapes";
+ }
+ return false;
+ } else if (warning && possibleWarning) {
+ *warning = "distinct dummy data object shapes";
}
- return false;
- } else if (warning && possibleWarning) {
- *warning = "distinct dummy data object shapes";
}
// Treat deduced dummy character type as if it were assumed-length character
// to avoid useless "implicit interfaces have distinct type" warnings from
@@ -343,10 +355,29 @@ bool DummyDataObject::IsCompatibleWith(const DummyDataObject &actual,
}
}
}
- if (!IdenticalSignificantAttrs(attrs, actual.attrs) ||
+ if (!attrs.test(Attr::DeducedFromActual) &&
+ !actual.attrs.test(Attr::DeducedFromActual) &&
type.attrs() != actual.type.attrs()) {
+ if (whyNot) {
+ *whyNot = "incompatible dummy data object shape attributes";
+ auto differences{type.attrs() ^ actual.type.attrs()};
+ auto sep{": "s};
+ differences.IterateOverMembers([&](TypeAndShape::Attr x) {
+ *whyNot += sep + std::string{TypeAndShape::EnumToString(x)};
+ sep = ", ";
+ });
+ }
+ return false;
+ }
+ if (!IdenticalSignificantAttrs(attrs, actual.attrs)) {
if (whyNot) {
*whyNot = "incompatible dummy data object attributes";
+ auto differences{attrs ^ actual.attrs};
+ auto sep{": "s};
+ differences.IterateOverMembers([&](DummyDataObject::Attr x) {
+ *whyNot += sep + std::string{EnumToString(x)};
+ sep = ", ";
+ });
}
return false;
}
@@ -900,6 +931,15 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
type->set_type(DynamicType{
type->type().GetDerivedTypeSpec(), /*poly=*/false});
}
+ if (type->type().category() == TypeCategory::Character &&
+ type->type().kind() == 1) {
+ type->set_isPossibleSequenceAssociation(true);
+ } else if (const Symbol * array{IsArrayElement(expr)}) {
+ type->set_isPossibleSequenceAssociation(
+ IsContiguous(*array, context).value_or(false));
+ } else {
+ type->set_isPossibleSequenceAssociation(expr.Rank() > 0);
+ }
DummyDataObject obj{std::move(*type)};
obj.attrs.set(DummyDataObject::Attr::DeducedFromActual);
return std::make_optional<DummyArgument>(
diff --git a/flang/test/Semantics/call43.f90 b/flang/test/Semantics/call43.f90
new file mode 100644
index 0000000000000..d8cc543a4838a
--- /dev/null
+++ b/flang/test/Semantics/call43.f90
@@ -0,0 +1,17 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+subroutine from(a, b, c, d)
+ real a(10), b(:), c
+ real, contiguous :: d(:)
+ call to(a)
+ call to(a(1)) ! ok
+ call to(b) ! ok, passed via temp
+ !WARNING: Reference to the procedure 'to' has an implicit interface that is distinct from another reference: incompatible dummy argument #1: incompatible dummy data object shapes
+ call to(b(1))
+ !WARNING: Reference to the procedure 'to' has an implicit interface that is distinct from another reference: incompatible dummy argument #1: incompatible dummy data object shapes
+ call to(c)
+ !WARNING: Reference to the procedure 'to' has an implicit interface that is distinct from another reference: incompatible dummy argument #1: incompatible dummy data object shapes
+ call to(1.)
+ call to([1., 2.]) ! ok
+ call to(d) ! ok
+ call to(d(1)) ! ok
+end
More information about the flang-commits
mailing list