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

[klausler]

Summary

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

[PeteSteinfeld]

There are lots of nooks and crannies in this language.

All builds and tests correctly and looks good.

[klausler]

In D119845#3323209, @PeteSteinfeld wrote:

There are lots of nooks and crannies in this language.

Such a polite way of describing it! I tend to reference historic railway disasters, myself.

flang/include/flang/Evaluate/characteristics.h

public:
   }
   const Shape &shape() const { return shape_; }
   const Attrs &attrs() const { return attrs_; }
   int corank() const { return corank_; }
 
   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;
   std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
       FoldingContext &) const;
 
   // called by Fold() to rewrite in place
   TypeAndShape &Rewrite(FoldingContext &);

flang/lib/Evaluate/characteristics.cpp

 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const ActualArgument &arg, FoldingContext &context) {
   return Characterize(arg.UnwrapExpr(), context);
 }
 
 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*/);
 }
 
 std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureElementSizeInBytes(
     FoldingContext &foldingContext, bool align) const {
   if (LEN_) {
     CHECK(type_.category() == TypeCategory::Character);

flang/lib/Semantics/pointer-assignment.cpp

bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
   } else if (isContiguous_ &&
       !funcResult->attrs.test(FunctionResult::Attr::Contiguous)) {
     msg = "CONTIGUOUS %s is associated with the result of reference to"
           " function '%s' that is not contiguous"_err_en_US;
   } else if (lhsType_) {
     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
     }
   }
   if (msg) {
     auto restorer{common::ScopedSet(lhs_, symbol)};
     Say(*msg, description_, funcName);
     return false;

flang/test/Semantics/assign03.f90

subroutine s9
     ! 10.2.2.3(9)
     !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
     p(1:5,1:5) => x(1:10,::2)
     ! 10.2.2.3(9)
     !ERROR: Pointer bounds require 25 elements but target has only 20
     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
     integer, pointer :: p(:)
     type :: t
       integer :: a(4, 4)
       integer :: b
     end type