[flang] Fix shape analysis of RESHAPE result

[klausler]

Summary

Shape analysis of RESHAPE(..., SHAPE=s) should of course return
the SHAPE= actual argument when it is constant; but when it is
not, its length is still known, and thus so is the rank of the
result of RESHAPE(), and shape analysis should at least return
a shape vector of the right length rather than a result that
makes the result appear to be a scalar, which can lead to some
bogus error messages.

Also, while here: rename a private GetShapeHelper::AsShape()
routine so that it can't be confused with the ones in the API
of shape.h.

[jeanPerier]

LGTM

flang/include/flang/Evaluate/shape.h

Result operator()(const Operation<D, R, LO, RO> &operation) const {
     } else {
       return (*this)(operation.left());
     }
   }
 
 private:
   static Result ScalarShape() { return Shape{}; }
   static Shape ConstantShape(const Constant<ExtentType> &);
-  Result AsShape(ExtentExpr &&) const;
+  Result AsShapeResult(ExtentExpr &&) const;
   static Shape CreateShape(int rank, NamedEntity &);
 
   template <typename T>
   MaybeExtentExpr GetArrayConstructorValueExtent(
       const ArrayConstructorValue<T> &value) const {
     return std::visit(
         common::visitors{
             [&](const Expr<T> &x) -> MaybeExtentExpr {

flang/lib/Evaluate/intrinsics.cpp

if (const ActualArgument * arg{actualForDummy[j]}) {
         if (rank != 1) {
           messages.Say(arg->sourceLocation(),
               "'shape=' argument must be an array of rank 1"_err_en_US);
           return std::nullopt;
         } else {
           if (auto shape{GetShape(context, *arg)}) {
             if (auto constShape{AsConstantShape(context, *shape)}) {
               shapeArgSize = constShape->At(ConstantSubscripts{1}).ToInt64();
-              CHECK(shapeArgSize >= 0);
+              CHECK(*shapeArgSize >= 0);
               argOk = true;
             }
           }
         }
         if (!argOk) {
           messages.Say(arg->sourceLocation(),
               "'shape=' argument must be a vector of known size"_err_en_US);
           return std::nullopt;

flang/lib/Evaluate/shape.cpp

Shape GetShapeHelper::ConstantShape(const Constant<ExtentType> &arrayConstant) {
   std::size_t dimensions{arrayConstant.size()};
   for (std::size_t j{0}; j < dimensions; ++j) {
     Scalar<ExtentType> extent{arrayConstant.values().at(j)};
     result.emplace_back(MaybeExtentExpr{ExtentExpr{std::move(extent)}});
   }
   return result;
 }
 
-auto GetShapeHelper::AsShape(ExtentExpr &&arrayExpr) const -> Result {
+auto GetShapeHelper::AsShapeResult(ExtentExpr &&arrayExpr) const -> Result {
   if (context_) {
     arrayExpr = Fold(*context_, std::move(arrayExpr));
   }
   if (const auto *constArray{UnwrapConstantValue<ExtentType>(arrayExpr)}) {
     return ConstantShape(*constArray);
   }
   if (auto *constructor{UnwrapExpr<ArrayConstructor<ExtentType>>(arrayExpr)}) {
     Shape result;
     for (auto &value : *constructor) {
-      if (auto *expr{std::get_if<ExtentExpr>(&value.u)}) {
-        if (expr->Rank() == 0) {
-          result.emplace_back(std::move(*expr));
-          continue;
-        }
-      }
+      auto *expr{std::get_if<ExtentExpr>(&value.u)};
+      if (expr && expr->Rank() == 0) {
+      } else {
         return std::nullopt;
       }
-    return result;
     }
+    return result;
+  } else {
     return std::nullopt;
   }
+}
 
 Shape GetShapeHelper::CreateShape(int rank, NamedEntity &base) {
   Shape shape;
   for (int dimension{0}; dimension < rank; ++dimension) {
     shape.emplace_back(GetExtent(base, dimension));
   }
   return shape;
 }
if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
               return std::move(*ashape); // matmul(matrix, vector)
             } else if (ashape->size() == 2 && bshape->size() == 2) {
               (*ashape)[1] = std::move((*bshape)[1]);
               return std::move(*ashape); // matmul(matrix, matrix)
             }
           }
         }
       }
-    } else if (intrinsic->name == "reshape") {
-      if (call.arguments().size() >= 2 && call.arguments().at(1)) {
-        // SHAPE(RESHAPE(array,shape)) -> shape
-        if (const auto *shapeExpr{
-                call.arguments().at(1).value().UnwrapExpr()}) {
-          auto shape{std::get<Expr<SomeInteger>>(shapeExpr->u)};
-          return AsShape(ConvertToType<ExtentType>(std::move(shape)));
-        }
-      }
     } else if (intrinsic->name == "pack") {
       if (call.arguments().size() >= 3 && call.arguments().at(2)) {
         // SHAPE(PACK(,,VECTOR=v)) -> SHAPE(v)
         return (*this)(call.arguments().at(2));
       } else if (call.arguments().size() >= 2 && context_) {
         if (auto maskShape{(*this)(call.arguments().at(1))}) {
           if (maskShape->size() == 0) {
             // Scalar MASK= -> [MERGE(SIZE(ARRAY=), 0, mask)]
if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
                 CallCharacteristics{"count"}, toCount, *context_)};
             CHECK(specific);
             return Shape{ExtentExpr{FunctionRef<ExtentType>{
                 ProcedureDesignator{std::move(specific->specificIntrinsic)},
                 std::move(specific->arguments)}}};
           }
         }
       }
+    } else if (intrinsic->name == "reshape") {
+      if (call.arguments().size() >= 2 && call.arguments().at(1)) {
+        // SHAPE(RESHAPE(array,shape)) -> shape
+        if (const auto *shapeExpr{
+                call.arguments().at(1).value().UnwrapExpr()}) {
+          auto shapeArg{std::get<Expr<SomeInteger>>(shapeExpr->u)};
+          if (auto result{AsShapeResult(
+                  ConvertToType<ExtentType>(std::move(shapeArg)))}) {
+            return result;
+          }
+        }
+      }
     } else if (intrinsic->name == "spread") {
       // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
       // at position DIM.
       if (call.arguments().size() == 3) {
         auto arrayShape{
             (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
         const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
         const auto *nCopies{
if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
       }
     } else if (intrinsic->characteristics.value().attrs.test(characteristics::
                        Procedure::Attr::NullPointer)) { // NULL(MOLD=)
       return (*this)(call.arguments());
     } else {
       // TODO: shapes of other non-elemental intrinsic results
     }
   }
-  return std::nullopt;
+  // The rank is always known even if the extents are not.
+  return Shape(static_cast<std::size_t>(call.Rank()), MaybeExtentExpr{});
 }
 
 // Check conformance of the passed shapes.
 std::optional<bool> CheckConformance(parser::ContextualMessages &messages,
     const Shape &left, const Shape &right, CheckConformanceFlags::Flags flags,
     const char *leftIs, const char *rightIs) {
   int n{GetRank(left)};
   if (n == 0 && (flags & CheckConformanceFlags::LeftScalarExpandable)) {

flang/test/Semantics/call03.f90

subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
     call assumedtypeandsize(x)  ! not an error
   end subroutine
 
   subroutine test10(a) ! 15.5.2.4(16)
     real :: scalar, matrix(2,3)
     real :: a(*)
     !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
     call assumedshape(scalar)
+    call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok
     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
     call assumedshape(matrix)
     !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
     call assumedshape(a)
   end subroutine
 
   subroutine test11(in) ! C15.5.2.4(20)
     real, intent(in) :: in