[flang-commits] [flang] 2107fe3 - [flang] Don't allow CALL RANDOM_NUMBER(assumed-size-array)

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-04-03T09:10:05-07:00
New Revision: 2107fe3821b2865fc6fab2b1e4b6f0c0d91a7c52

URL: https://github.com/llvm/llvm-project/commit/2107fe3821b2865fc6fab2b1e4b6f0c0d91a7c52
DIFF: https://github.com/llvm/llvm-project/commit/2107fe3821b2865fc6fab2b1e4b6f0c0d91a7c52.diff

LOG: [flang] Don't allow CALL RANDOM_NUMBER(assumed-size-array)

The extents, if any, of the HARVEST= actual argument must be known
at execution time for the call to be implemented.

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

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/misc-intrinsics.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index e25474577e35..c49e5c80c035 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -91,6 +91,7 @@ end
 * A module name from a `USE` statement can also be used as a
   non-global name in the same scope.  This is not conforming,
   but it is useful and unambiguous.
+* The argument to `RANDOM_NUMBER` may not be an assumed-size array.
 
 ## Extensions, deletions, and legacy features supported by default
 

diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 41e1e5c01cdc..7134c3b6858e 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -226,7 +226,7 @@ ENUM_CLASS(ArgFlag, none,
     defaultsToSameKind, // for MatchingDefaultKIND
     defaultsToSizeKind, // for SizeDefaultKIND
     defaultsToDefaultForResult, // for DefaultingKIND
-)
+    notAssumedSize)
 
 struct IntrinsicDummyArgument {
   const char *keyword{nullptr};
@@ -813,8 +813,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
         Rank::scalar, IntrinsicClass::inquiryFunction},
     {"spacing", {{"x", SameReal}}, SameReal},
     {"spread",
-        {{"source", SameType, Rank::known}, RequiredDIM,
-            {"ncopies", AnyInt, Rank::scalar}},
+        {{"source", SameType, Rank::known, Optionality::required,
+             common::Intent::In, {ArgFlag::notAssumedSize}},
+            RequiredDIM, {"ncopies", AnyInt, Rank::scalar}},
         SameType, Rank::rankPlus1, IntrinsicClass::transformationalFunction},
     {"sqrt", {{"x", SameFloating}}, SameFloating},
     {"stopped_images", {OptionalTEAM, SizeDefaultKIND}, KINDInt, Rank::vector,
@@ -1366,7 +1367,7 @@ static const IntrinsicInterface intrinsicSubroutine[]{
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"random_number",
         {{"harvest", AnyReal, Rank::known, Optionality::required,
-            common::Intent::Out}},
+            common::Intent::Out, {ArgFlag::notAssumedSize}}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"random_seed",
         {{"size", DefaultInt, Rank::scalar, Optionality::optional,
@@ -1689,6 +1690,16 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         }
       }
     }
+    if (d.flags.test(ArgFlag::notAssumedSize)) {
+      if (auto named{ExtractNamedEntity(*arg)}) {
+        if (semantics::IsAssumedSizeArray(named->GetLastSymbol())) {
+          messages.Say(arg->sourceLocation(),
+              "The '%s=' argument to the intrinsic procedure '%s' may not be assumed-size"_err_en_US,
+              d.keyword, name);
+          return std::nullopt;
+        }
+      }
+    }
     if (arg->GetAssumedTypeDummy()) {
       // TYPE(*) assumed-type dummy argument forwarded to intrinsic
       if (d.typePattern.categorySet == AnyType &&
@@ -1973,8 +1984,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
             if (semantics::IsAssumedSizeArray(named->GetLastSymbol())) {
               if (strcmp(name, "shape") == 0) {
                 messages.Say(arg->sourceLocation(),
-                    "The '%s=' argument to the intrinsic function '%s' may not be assumed-size"_err_en_US,
-                    d.keyword, name);
+                    "The 'source=' argument to the intrinsic function 'shape' may not be assumed-size"_err_en_US);
               } else {
                 messages.Say(arg->sourceLocation(),
                     "A dim= argument is required for '%s' when the array is assumed-size"_err_en_US,

diff  --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90
index 2433ffa13ecb..31efc3e6c14b 100644
--- a/flang/test/Semantics/misc-intrinsics.f90
+++ b/flang/test/Semantics/misc-intrinsics.f90
@@ -13,6 +13,8 @@ subroutine test(arg)
     print *, ubound(arg)
     !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
     print *, shape(arg)
+    !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
+    call random_number(arg)
     !ERROR: missing mandatory 'dim=' argument
     print *, lbound(scalar)
     !ERROR: 'array=' argument has unacceptable rank 0