[flang] Catch errors with intrinsic array inquiry functions

[klausler]

Summary

The intrinsic inquiry functions SIZE and UBOUND -- but not LBOUND --
require a DIM= argument if their first argument is an assumed-size
array. The intrinsic SHAPE must not be used with an assumed-size
array.

[PeteSteinfeld]

Looks great!

flang/lib/Evaluate/intrinsics.cpp

ENUM_CLASS(Rank,
     reduceOperation, // a pure function with constraints for REDUCE
     dimReduced, // scalar if no DIM= argument, else rank(array)-1
     dimRemovedOrScalar, // rank(array)-1 (less DIM) or scalar
     locReduced, // vector(1:rank) if no DIM= argument, else rank(array)-1
     rankPlus1, // rank(known)+1
     shaped, // rank is length of SHAPE vector
 )
 
-ENUM_CLASS(Optionality, required, optional, missing,
+ENUM_CLASS(Optionality, required,
+    optional, // unless DIM= for SIZE(assumedSize)
+    missing, // for DIM= cases like FINDLOC
     defaultsToSameKind, // for MatchingDefaultKIND
     defaultsToDefaultForResult, // for DefaultingKIND
     defaultsToSizeKind, // for SizeDefaultKIND
     repeats, // for MAX/MIN and their several variants
 )
 
 struct IntrinsicDummyArgument {
   const char *keyword{nullptr};
static const IntrinsicInterface genericIntrinsicFunction[]{
     {"shifta", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
     {"shiftl", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
     {"shiftr", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
     {"sign", {{"a", SameIntOrReal}, {"b", SameIntOrReal}}, SameIntOrReal},
     {"sin", {{"x", SameFloating}}, SameFloating},
     {"sind", {{"x", SameFloating}}, SameFloating},
     {"sinh", {{"x", SameFloating}}, SameFloating},
     {"size",
-        {{"array", AnyData, Rank::anyOrAssumedRank}, OptionalDIM,
+        {{"array", AnyData, Rank::anyOrAssumedRank},
+            OptionalDIM, // unless array is assumed-size
             SizeDefaultKIND},
         KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
     {"sizeof", {{"a", AnyData, Rank::anyOrAssumedRank}}, SubscriptInt,
         Rank::scalar, IntrinsicClass::inquiryFunction},
     {"spacing", {{"x", SameReal}}, SameReal},
     {"spread",
         {{"source", SameType, Rank::known}, RequiredDIM,
             {"ncopies", AnyInt, Rank::scalar}},
std::optional<SpecificCall> IntrinsicInterface::Match(
   const ActualArgument *arrayArg{nullptr};
   const char *arrayArgName{nullptr};
   const ActualArgument *knownArg{nullptr};
   std::optional<int> shapeArgSize;
   int elementalRank{0};
   for (std::size_t j{0}; j < dummies; ++j) {
     const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
     if (const ActualArgument * arg{actualForDummy[j]}) {
-      if (IsAssumedRank(*arg) && d.rank != Rank::anyOrAssumedRank) {
+      bool isAssumedRank{IsAssumedRank(*arg)};
+      if (isAssumedRank && d.rank != Rank::anyOrAssumedRank) {
         messages.Say("Assumed-rank array cannot be forwarded to "
                      "'%s=' argument"_err_en_US,
             d.keyword);
         return std::nullopt;
       }
       int rank{arg->Rank()};
       bool argOk{false};
       switch (d.rank) {
if (const ActualArgument * arg{actualForDummy[j]}) {
         break;
       case Rank::known:
         if (!knownArg) {
           knownArg = arg;
         }
         argOk = rank == knownArg->Rank();
         break;
       case Rank::anyOrAssumedRank:
+        if (!hasDimArg && rank > 0 && !isAssumedRank &&
+            (std::strcmp(name, "shape") == 0 ||
+                std::strcmp(name, "size") == 0 ||
+                std::strcmp(name, "ubound") == 0)) {
+          // Check for an assumed-size array argument.
+          // These are disallowed for SHAPE, and require DIM= for
+          // SIZE and UBOUND.
+          // (A previous error message for UBOUND will take precedence
+          // over this one, as this error is caught by the second entry
+          // for UBOUND.)
+          if (std::optional<Shape> shape{GetShape(context, *arg)}) {
+            if (!shape->empty() && !shape->back().has_value()) {
+              if (strcmp(name, "shape") == 0) {
+                messages.Say(
+                    "The '%s=' argument to the intrinsic function '%s' may not be assumed-size"_err_en_US,
+                    d.keyword, name);
+              } else {
+                messages.Say(
+                    "A dim= argument is required for '%s' when the array is assumed-size"_err_en_US,
+                    name);
+              }
+              return std::nullopt;
+            }
+          }
+        }
         argOk = true;
         break;
       case Rank::conformable: // arg must be conformable with previous arrayArg
         CHECK(arrayArg);
         CHECK(arrayArgName);
         if (const std::optional<Shape> &arrayArgShape{
                 GetShape(context, *arrayArg)}) {
-          if (const std::optional<Shape> &argShape{GetShape(context, *arg)}) {
+          if (std::optional<Shape> argShape{GetShape(context, *arg)}) {
             std::string arrayArgMsg{"'"};
             arrayArgMsg = arrayArgMsg + arrayArgName + "='" + " argument";
             std::string argMsg{"'"};
             argMsg = argMsg + d.keyword + "='" + " argument";
             CheckConformance(context.messages(), *arrayArgShape, *argShape,
                 CheckConformanceFlags::RightScalarExpandable,
                 arrayArgMsg.c_str(), argMsg.c_str());
           }

flang/test/Semantics/misc-intrinsics.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Miscellaneous constraint and requirement checking on intrinsics
+program test_size
+  real, dimension(5, 5) :: array
+  call test(array)
+ contains
+  subroutine test(arg)
+    real, dimension(5, *) :: arg
+    !ERROR: A dim= argument is required for 'size' when the array is assumed-size
+    print *, size(arg)
+    !ERROR: missing mandatory 'dim=' argument
+    print *, ubound(arg)
+    !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
+    print *, shape(arg)
+    ! But these cases are fine:
+    print *, size(arg, dim=1)
+    print *, ubound(arg, dim=1)
+    print *, lbound(arg)
+    print *, size(array)
+    print *, ubound(array)
+    print *, lbound(array)
+  end subroutine
+end