[flang-commits] [flang] 7763c01 - [flang] Accept pointer assignment w/ remapping to function result

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-02-15T09:39:34-08:00
New Revision: 7763c01401482bc93cac768623a2b6eaf8476637

URL: https://github.com/llvm/llvm-project/commit/7763c01401482bc93cac768623a2b6eaf8476637
DIFF: https://github.com/llvm/llvm-project/commit/7763c01401482bc93cac768623a2b6eaf8476637.diff

LOG: [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

Added: 
    

Modified: 
    flang/include/flang/Evaluate/characteristics.h
    flang/lib/Evaluate/characteristics.cpp
    flang/lib/Semantics/pointer-assignment.cpp
    flang/test/Semantics/assign03.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 098520cf8bc28..4c9f94652859b 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -147,7 +147,7 @@ class TypeAndShape {
   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;

diff  --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index c32c370f44c07..40263f6fc5517 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -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*/);
 }

diff  --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 0fe864308fdcf..2b065253bdc70 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -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
     }

diff  --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index 0c385b167c928..b7431893d9dbc 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -218,6 +218,13 @@ subroutine s9
     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