diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -147,7 +147,7 @@ int Rank() const { return GetRank(shape_); } bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that, const char *thisIs = "pointer", const char *thatIs = "target", - bool isElemental = false, + bool omitShapeConformanceCheck = false, enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const; std::optional> MeasureElementSizeInBytes( FoldingContext &, bool align) const; diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -149,14 +149,15 @@ bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages, const TypeAndShape &that, const char *thisIs, const char *thatIs, - bool isElemental, enum CheckConformanceFlags::Flags flags) const { + bool omitShapeConformanceCheck, + enum CheckConformanceFlags::Flags flags) const { if (!type_.IsTkCompatibleWith(that.type_)) { messages.Say( "%1$s type '%2$s' is not compatible with %3$s type '%4$s'"_err_en_US, thatIs, that.AsFortran(), thisIs, AsFortran()); return false; } - return isElemental || + return omitShapeConformanceCheck || CheckConformance(messages, shape_, that.shape_, flags, thisIs, thatIs) .value_or(true /*fail only when nonconformance is known now*/); } diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -172,7 +172,8 @@ const auto *frTypeAndShape{funcResult->GetTypeAndShape()}; CHECK(frTypeAndShape); if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape, - "pointer", "function result", false /*elemental*/, + "pointer", "function result", + isBoundsRemapping_ /*omit shape check*/, evaluate::CheckConformanceFlags::BothDeferredShape)) { return false; // IsCompatibleWith() emitted message } diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -218,6 +218,13 @@ p(1:5,1:5) => x(:,1:2) !OK - rhs has rank 1 and enough elements p(1:5,1:5) => y(1:100:2) + !OK - same, but from function result + p(1:5,1:5) => f() + contains + function f() + real, pointer :: f(:) + f => y + end function end subroutine s10