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

[klausler]

Summary

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

flang/docs/Extensions.md

* Construct names like `loop` in `loop: do j=1,n` are defined to
   names, so does f18, with a portability warning.
 * 15.6.4 paragraph 2 prohibits an implicitly typed statement function
   from sharing the same name as a symbol in its scope's host, if it
   has one.
   We accept this usage with a portability warning.
 * 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
 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`

flang/lib/Evaluate/intrinsics.cpp

ENUM_CLASS(Optionality, required,
     repeats, // for MAX/MIN and their several variants
 )
 
 ENUM_CLASS(ArgFlag, none,
     canBeNull, // actual argument can be NULL()
     defaultsToSameKind, // for MatchingDefaultKIND
     defaultsToSizeKind, // for SizeDefaultKIND
     defaultsToDefaultForResult, // for DefaultingKIND
-)
+    notAssumedSize)
 
 struct IntrinsicDummyArgument {
   const char *keyword{nullptr};
   TypePattern typePattern;
   Rank rank{Rank::elemental};
   Optionality optionality{Optionality::required};
   common::Intent intent{common::Intent::In};
   common::EnumSet<ArgFlag, 32> flags{};
// NULL() is a special case handled in Probe() below
         {{"array", AnyData, Rank::arrayOrAssumedRank},
             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}},
+        {{"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,
         IntrinsicClass::transformationalFunction},
     {"storage_size",
         {{"a", AnyData, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::In, {ArgFlag::canBeNull}},
             SizeDefaultKIND},
static const IntrinsicInterface intrinsicSubroutine[]{
             {"topos", AnyInt}},
         {}, Rank::elemental, IntrinsicClass::elementalSubroutine}, // elemental
     {"random_init",
         {{"repeatable", AnyLogical, Rank::scalar},
             {"image_distinct", AnyLogical, Rank::scalar}},
         {}, 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,
              common::Intent::Out},
             {"put", DefaultInt, Rank::vector, Optionality::optional},
             {"get", DefaultInt, Rank::vector, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
if (!d.flags.test(ArgFlag::canBeNull)) {
         if (IsNullPointer(*expr)) {
           messages.Say(arg->sourceLocation(),
               "A NULL() pointer is not allowed for '%s=' intrinsic argument"_err_en_US,
               d.keyword);
           return std::nullopt;
         }
       }
     }
+    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 &&
           (d.rank == Rank::anyOrAssumedRank ||
               d.rank == Rank::arrayOrAssumedRank) &&
           (d.typePattern.kindCode == KindCode::any ||
               d.typePattern.kindCode == KindCode::addressable)) {
         continue;
if (const ActualArgument *arg{actualForDummy[j]}) {
           // 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 (auto named{ExtractNamedEntity(*arg)}) {
             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,
                     name);
               }
               return std::nullopt;
             }
           }

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 :: scalar
   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)
+    !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
     print *, size(scalar)
     !ERROR: missing mandatory 'dim=' argument
     print *, ubound(scalar)
     ! But these cases are fine:
     print *, size(arg, dim=1)