diff options
author | peter klausler <pklausler@nvidia.com> | 2020-12-15 10:54:36 -0800 |
---|---|---|
committer | peter klausler <pklausler@nvidia.com> | 2020-12-15 16:26:18 -0800 |
commit | d6a74ec826adac16f715c5700fc102c62d1a8bf0 (patch) | |
tree | 99af5820730605996b46a3768d24995d5fa2cab5 /flang | |
parent | 09edd9df6e1fa8c316de82aac3718cb9adf17f15 (diff) | |
download | llvm-d6a74ec826adac16f715c5700fc102c62d1a8bf0.tar.gz |
[flang] Fix false error message for "ptr => func()" array conformance
Pointers must have deferred shapes, so CheckConformance must be
extended to allow for them.
Differential Revision: https://reviews.llvm.org/D93320
Diffstat (limited to 'flang')
-rw-r--r-- | flang/include/flang/Evaluate/characteristics.h | 5 | ||||
-rw-r--r-- | flang/include/flang/Evaluate/shape.h | 3 | ||||
-rw-r--r-- | flang/lib/Evaluate/characteristics.cpp | 6 | ||||
-rw-r--r-- | flang/lib/Evaluate/shape.cpp | 24 | ||||
-rw-r--r-- | flang/lib/Semantics/pointer-assignment.cpp | 4 | ||||
-rw-r--r-- | flang/test/Semantics/null01.f90 | 4 |
6 files changed, 28 insertions, 18 deletions
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h index bd0e1bf8186e..5d140a642c86 100644 --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -145,8 +145,9 @@ public: int Rank() const { return GetRank(shape_); } bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that, - const char *thisIs = "POINTER", const char *thatIs = "TARGET", - bool isElemental = false) const; + const char *thisIs = "pointer", const char *thatIs = "target", + bool isElemental = false, bool thisIsDeferredShape = false, + bool thatIsDeferredShape = false) const; std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes( FoldingContext * = nullptr) const; diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h index dc76afe57b40..da0b958a3beb 100644 --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/include/flang/Evaluate/shape.h @@ -211,7 +211,8 @@ std::optional<ConstantSubscripts> GetConstantExtents( bool CheckConformance(parser::ContextualMessages &, const Shape &left, const Shape &right, const char *leftIs = "left operand", const char *rightIs = "right operand", bool leftScalarExpandable = true, - bool rightScalarExpandable = true); + bool rightScalarExpandable = true, bool leftIsDeferredShape = false, + bool rightIsDeferredShape = false); // Increments one-based subscripts in element order (first varies fastest) // and returns true when they remain in range; resets them all to one and diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index f88e518b4891..7b7e62ee179e 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -150,7 +150,8 @@ std::optional<TypeAndShape> TypeAndShape::Characterize( bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages, const TypeAndShape &that, const char *thisIs, const char *thatIs, - bool isElemental) const { + bool isElemental, bool thisIsDeferredShape, + bool thatIsDeferredShape) const { if (!type_.IsTkCompatibleWith(that.type_)) { const auto &len{that.LEN()}; messages.Say( @@ -161,7 +162,8 @@ bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages, } return isElemental || CheckConformance(messages, shape_, that.shape_, thisIs, thatIs, false, - false /* no scalar expansion */); + false /* no scalar expansion */, thisIsDeferredShape, + thatIsDeferredShape); } std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes( diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index 37373ae95692..b740c81e0796 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -683,7 +683,8 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result { // that they conform bool CheckConformance(parser::ContextualMessages &messages, const Shape &left, const Shape &right, const char *leftIs, const char *rightIs, - bool leftScalarExpandable, bool rightScalarExpandable) { + bool leftScalarExpandable, bool rightScalarExpandable, + bool leftIsDeferredShape, bool rightIsDeferredShape) { int n{GetRank(left)}; if (n == 0 && leftScalarExpandable) { return true; @@ -698,15 +699,18 @@ bool CheckConformance(parser::ContextualMessages &messages, const Shape &left, return false; } for (int j{0}; j < n; ++j) { - auto leftDim{ToInt64(left[j])}; - auto rightDim{ToInt64(right[j])}; - if (!leftDim || !rightDim) { - return false; - } - if (*leftDim != *rightDim) { - messages.Say("Dimension %1$d of %2$s has extent %3$jd, " - "but %4$s has extent %5$jd"_err_en_US, - j + 1, leftIs, *leftDim, rightIs, *rightDim); + if (auto leftDim{ToInt64(left[j])}) { + if (auto rightDim{ToInt64(right[j])}) { + if (*leftDim != *rightDim) { + messages.Say("Dimension %1$d of %2$s has extent %3$jd, " + "but %4$s has extent %5$jd"_err_en_US, + j + 1, leftIs, *leftDim, rightIs, *rightDim); + return false; + } + } else if (!rightIsDeferredShape) { + return false; + } + } else if (!leftIsDeferredShape) { return false; } } diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp index dc5611cb257b..8cf46f5a5cda 100644 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -169,7 +169,9 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) { } else if (lhsType_) { const auto *frTypeAndShape{funcResult->GetTypeAndShape()}; CHECK(frTypeAndShape); - if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape)) { + if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape, + "pointer", "function result", false /*elemental*/, + true /*left: deferred shape*/, true /*right: deferred shape*/)) { msg = "%s is associated with the result of a reference to function '%s'" " whose pointer result has an incompatible type or shape"_err_en_US; } diff --git a/flang/test/Semantics/null01.f90 b/flang/test/Semantics/null01.f90 index a034d1b7b3df..0cfea52bcd3e 100644 --- a/flang/test/Semantics/null01.f90 +++ b/flang/test/Semantics/null01.f90 @@ -61,10 +61,10 @@ subroutine test dt0x = dt0(ip0=null()) dt0x = dt0(ip0=null(ip0)) dt0x = dt0(ip0=null(mold=ip0)) - !ERROR: TARGET type 'REAL(4)' is not compatible with POINTER type 'INTEGER(4)' + !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)' !ERROR: pointer 'ip0' is associated with the result of a reference to function 'null' whose pointer result has an incompatible type or shape dt0x = dt0(ip0=null(mold=rp0)) - !ERROR: TARGET type 'REAL(4)' is not compatible with POINTER type 'INTEGER(4)' + !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)' !ERROR: pointer 'ip1' is associated with the result of a reference to function 'null' whose pointer result has an incompatible type or shape dt1x = dt1(ip1=null(mold=rp1)) dt2x = dt2(pps0=null()) |