[flang-commits] [flang] 7ff9208 - [flang] Catch errors with intrinsic array inquiry functions

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-09-17T09:24:52-07:00
New Revision: 7ff920826c8d09404803ae5225341218589beb18

URL: https://github.com/llvm/llvm-project/commit/7ff920826c8d09404803ae5225341218589beb18
DIFF: https://github.com/llvm/llvm-project/commit/7ff920826c8d09404803ae5225341218589beb18.diff

LOG: [flang] Catch errors with intrinsic array inquiry functions

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.

Differential Revision: https://reviews.llvm.org/D109912

Added: 
    flang/test/Semantics/misc-intrinsics.f90

Modified: 
    flang/lib/Evaluate/intrinsics.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 59d6517338d5..949c7c2cc170 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -189,7 +189,9 @@ ENUM_CLASS(Rank,
     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
@@ -722,7 +724,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"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,
@@ -1372,7 +1375,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   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);
@@ -1443,6 +1447,31 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         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
@@ -1450,7 +1479,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         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{"'"};

diff  --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90
new file mode 100644
index 000000000000..0dc65fbd098c
--- /dev/null
+++ b/flang/test/Semantics/misc-intrinsics.f90
@@ -0,0 +1,23 @@
+! 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