[flang] Accept pointer assignment w/ remapping to function result

When a pointer assignment with bounds remapping has a function
reference as its right-hand side, don't check for array conformance.

Differential Revision: https://reviews.llvm.org/D119845
This commit is contained in:
Peter Klausler 2022-02-08 13:49:40 -08:00
parent 3d85424096
commit 7763c01401
4 changed files with 13 additions and 4 deletions

View file

@ -147,7 +147,7 @@ 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,
bool omitShapeConformanceCheck = false,
enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const;
std::optional<Expr<SubscriptInteger>> MeasureElementSizeInBytes(
FoldingContext &, bool align) const;

View file

@ -149,14 +149,15 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
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*/);
}

View file

@ -172,7 +172,8 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
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
}

View file

@ -218,6 +218,13 @@ contains
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