[flang-commits] [flang] cc71e69 - [flang] Intrinsic RANDOM_SEED calls with dynamically absent/present arguments

V Donaldson via flang-commits flang-commits at lists.llvm.org
Tue Aug 9 09:09:28 PDT 2022


Author: V Donaldson
Date: 2022-08-09T09:08:55-07:00
New Revision: cc71e69459474c19ae7c0ce019abd7a5e12430d6

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

LOG: [flang] Intrinsic RANDOM_SEED calls with dynamically absent/present arguments

Added: 
    

Modified: 
    flang/include/flang/Lower/Runtime.h
    flang/include/flang/Runtime/random.h
    flang/lib/Evaluate/intrinsics.cpp
    flang/lib/Lower/CustomIntrinsicCall.cpp
    flang/lib/Lower/IntrinsicCall.cpp
    flang/lib/Lower/Runtime.cpp
    flang/runtime/random.cpp
    flang/test/Lower/Intrinsics/random.f90
    flang/unittests/Runtime/Random.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h
index 8f23c066d24ae..11eedf8972525 100644
--- a/flang/include/flang/Lower/Runtime.h
+++ b/flang/include/flang/Lower/Runtime.h
@@ -78,8 +78,8 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location,
 void genRandomInit(fir::FirOpBuilder &, mlir::Location, mlir::Value repeatable,
                    mlir::Value imageDistinct);
 void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest);
-void genRandomSeed(fir::FirOpBuilder &, mlir::Location, int argIndex,
-                   mlir::Value argBox);
+void genRandomSeed(fir::FirOpBuilder &, mlir::Location, mlir::Value size,
+                   mlir::Value put, mlir::Value get);
 
 /// generate runtime call to transfer intrinsic with no size argument
 void genTransfer(fir::FirOpBuilder &builder, mlir::Location loc,

diff  --git a/flang/include/flang/Runtime/random.h b/flang/include/flang/Runtime/random.h
index 388a58973b53f..269297dff47db 100644
--- a/flang/include/flang/Runtime/random.h
+++ b/flang/include/flang/Runtime/random.h
@@ -20,11 +20,18 @@ void RTNAME(RandomInit)(bool repeatable, bool image_distinct);
 void RTNAME(RandomNumber)(
     const Descriptor &harvest, const char *source, int line);
 
-// Subroutine RANDOM_SEED can be called with at most one of its optional
-// arguments; they each (plus the default case) map to these entry points.
-void RTNAME(RandomSeedSize)(const Descriptor &, const char *source, int line);
-void RTNAME(RandomSeedPut)(const Descriptor &, const char *source, int line);
-void RTNAME(RandomSeedGet)(const Descriptor &, const char *source, int line);
+// RANDOM_SEED may be called with a value for at most one of its three
+// optional arguments.  Most calls map to an entry point for that value,
+// or the entry point for no values.  If argument presence cannot be
+// determined at compile time, function RandomSeed can be called to make
+// the selection at run time.
+void RTNAME(RandomSeedSize)(
+    const Descriptor *size, const char *source, int line);
+void RTNAME(RandomSeedPut)(const Descriptor *put, const char *source, int line);
+void RTNAME(RandomSeedGet)(const Descriptor *get, const char *source, int line);
 void RTNAME(RandomSeedDefaultPut)();
+void RTNAME(RandomSeed)(const Descriptor *size, const Descriptor *put,
+    const Descriptor *get, const char *source, int line);
+
 } // extern "C"
 } // namespace Fortran::runtime

diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 7c2a3297b012d..79aaace8e2bb8 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2557,7 +2557,14 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
     if (call.name == "__builtin_c_f_pointer") {
       return HandleC_F_Pointer(arguments, context);
     } else if (call.name == "random_seed") {
-      if (arguments.size() != 0 && arguments.size() != 1) {
+      int optionalCount{0};
+      for (const auto &arg : arguments) {
+        if (const auto *expr{arg->UnwrapExpr()}) {
+          optionalCount +=
+              Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, context);
+        }
+      }
+      if (arguments.size() - optionalCount > 1) {
         context.messages().Say(
             "RANDOM_SEED must have either 1 or no arguments"_err_en_US);
       }

diff  --git a/flang/lib/Lower/CustomIntrinsicCall.cpp b/flang/lib/Lower/CustomIntrinsicCall.cpp
index 1eecd91f5d922..2ceab2a1a70de 100644
--- a/flang/lib/Lower/CustomIntrinsicCall.cpp
+++ b/flang/lib/Lower/CustomIntrinsicCall.cpp
@@ -22,7 +22,7 @@
 /// arguments.
 static bool isMinOrMaxWithDynamicallyOptionalArg(
     llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef,
-    Fortran::evaluate::FoldingContext &foldingContex) {
+    Fortran::evaluate::FoldingContext &foldingContext) {
   if (name != "min" && name != "max")
     return false;
   const auto &args = procRef.arguments();
@@ -32,7 +32,7 @@ static bool isMinOrMaxWithDynamicallyOptionalArg(
   for (std::size_t i = 2; i < argSize; ++i) {
     if (auto *expr =
             Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(args[i]))
-      if (Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContex))
+      if (Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContext))
         return true;
   }
   return false;
@@ -43,31 +43,13 @@ static bool isMinOrMaxWithDynamicallyOptionalArg(
 /// when absent is not zero.
 static bool isIshftcWithDynamicallyOptionalArg(
     llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef,
-    Fortran::evaluate::FoldingContext &foldingContex) {
+    Fortran::evaluate::FoldingContext &foldingContext) {
   if (name != "ishftc" || procRef.arguments().size() < 3)
     return false;
   auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(
       procRef.arguments()[2]);
   return expr &&
-         Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContex);
-}
-
-/// Is this a call to the RANDOM_SEED intrinsic with arguments that may be
-/// absent at runtime? This is a special case because that aspect cannot
-/// be delegated to the runtime via a null fir.box or address given the current
-/// runtime entry point.
-static bool isRandomSeedWithDynamicallyOptionalArg(
-    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef,
-    Fortran::evaluate::FoldingContext &foldingContex) {
-  if (name != "random_seed")
-    return false;
-  for (const auto &arg : procRef.arguments()) {
-    auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg);
-    if (expr &&
-        Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContex))
-      return true;
-  }
-  return false;
+         Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContext);
 }
 
 bool Fortran::lower::intrinsicRequiresCustomOptionalHandling(
@@ -77,8 +59,7 @@ bool Fortran::lower::intrinsicRequiresCustomOptionalHandling(
   llvm::StringRef name = intrinsic.name;
   Fortran::evaluate::FoldingContext &fldCtx = converter.getFoldingContext();
   return isMinOrMaxWithDynamicallyOptionalArg(name, procRef, fldCtx) ||
-         isIshftcWithDynamicallyOptionalArg(name, procRef, fldCtx) ||
-         isRandomSeedWithDynamicallyOptionalArg(name, procRef, fldCtx);
+         isIshftcWithDynamicallyOptionalArg(name, procRef, fldCtx);
 }
 
 static void prepareMinOrMaxArguments(
@@ -229,13 +210,10 @@ void Fortran::lower::prepareCustomIntrinsicArgument(
     return prepareMinOrMaxArguments(procRef, intrinsic, retTy,
                                     prepareOptionalArgument,
                                     prepareOtherArgument, converter);
-  if (name == "ishftc")
-    return prepareIshftcArguments(procRef, intrinsic, retTy,
-                                  prepareOptionalArgument, prepareOtherArgument,
-                                  converter);
-  TODO(converter.getCurrentLocation(),
-       "unhandled dynamically optional arguments in SYSTEM_CLOCK or "
-       "RANDOM_SEED");
+  assert(name == "ishftc" && "unexpected custom intrinsic argument call");
+  return prepareIshftcArguments(procRef, intrinsic, retTy,
+                                prepareOptionalArgument, prepareOtherArgument,
+                                converter);
 }
 
 fir::ExtendedValue Fortran::lower::lowerCustomIntrinsic(
@@ -246,9 +224,7 @@ fir::ExtendedValue Fortran::lower::lowerCustomIntrinsic(
   if (name == "min" || name == "max")
     return lowerMinOrMax(builder, loc, name, retTy, isPresentCheck, getOperand,
                          numOperands, stmtCtx);
-  if (name == "ishftc")
-    return lowerIshftc(builder, loc, name, retTy, isPresentCheck, getOperand,
-                       numOperands, stmtCtx);
-  TODO(loc, "unhandled dynamically optional arguments in SYSTEM_CLOCK or "
-            "RANDOM_SEED");
+  assert(name == "ishftc" && "unexpected custom intrinsic call");
+  return lowerIshftc(builder, loc, name, retTy, isPresentCheck, getOperand,
+                     numOperands, stmtCtx);
 }

diff  --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index ec2923b91f5dd..6b8ab4acccb89 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -903,7 +903,9 @@ static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/false},
     {"random_seed",
      &I::genRandomSeed,
-     {{{"size", asBox}, {"put", asBox}, {"get", asBox}}},
+     {{{"size", asBox, handleDynamicOptional},
+       {"put", asBox, handleDynamicOptional},
+       {"get", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"repeat",
      &I::genRepeat,
@@ -3672,12 +3674,16 @@ void IntrinsicLibrary::genRandomNumber(
 // RANDOM_SEED
 void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 3);
-  for (int i = 0; i < 3; ++i)
-    if (isStaticallyPresent(args[i])) {
-      Fortran::lower::genRandomSeed(builder, loc, i, fir::getBase(args[i]));
-      return;
-    }
-  Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{});
+  mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+  auto getDesc = [&](int i) {
+    return isStaticallyPresent(args[i])
+               ? fir::getBase(args[i])
+               : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  };
+  mlir::Value size = getDesc(0);
+  mlir::Value put = getDesc(1);
+  mlir::Value get = getDesc(2);
+  Fortran::lower::genRandomSeed(builder, loc, size, put, get);
 }
 
 // REPEAT

diff  --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index 04d7e984a2e43..6322e5460a53b 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -262,35 +262,51 @@ void Fortran::lower::genRandomNumber(fir::FirOpBuilder &builder,
 }
 
 void Fortran::lower::genRandomSeed(fir::FirOpBuilder &builder,
-                                   mlir::Location loc, int argIndex,
-                                   mlir::Value argBox) {
+                                   mlir::Location loc, mlir::Value size,
+                                   mlir::Value put, mlir::Value get) {
+  bool sizeIsPresent =
+      !mlir::isa_and_nonnull<fir::AbsentOp>(size.getDefiningOp());
+  bool putIsPresent =
+      !mlir::isa_and_nonnull<fir::AbsentOp>(put.getDefiningOp());
+  bool getIsPresent =
+      !mlir::isa_and_nonnull<fir::AbsentOp>(get.getDefiningOp());
   mlir::func::FuncOp func;
-  // argIndex is the nth (0-origin) argument in declaration order,
-  // or -1 if no argument is present.
-  switch (argIndex) {
-  case -1:
+  int staticArgCount = sizeIsPresent + putIsPresent + getIsPresent;
+  if (staticArgCount == 0) {
     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedDefaultPut)>(loc,
                                                                        builder);
     builder.create<fir::CallOp>(loc, func);
     return;
-  case 0:
+  }
+  mlir::FunctionType funcTy;
+  mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+  mlir::Value sourceLine;
+  mlir::Value argBox;
+  llvm::SmallVector<mlir::Value> args;
+  if (staticArgCount > 1) {
+    func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeed)>(loc, builder);
+    funcTy = func.getFunctionType();
+    sourceLine =
+        fir::factory::locationToLineNo(builder, loc, funcTy.getInput(4));
+    args = fir::runtime::createArguments(builder, loc, funcTy, size, put, get,
+                                         sourceFile, sourceLine);
+    builder.create<fir::CallOp>(loc, func, args);
+    return;
+  }
+  if (sizeIsPresent) {
     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedSize)>(loc, builder);
-    break;
-  case 1:
+    argBox = size;
+  } else if (putIsPresent) {
     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedPut)>(loc, builder);
-    break;
-  case 2:
+    argBox = put;
+  } else {
     func = fir::runtime::getRuntimeFunc<mkRTKey(RandomSeedGet)>(loc, builder);
-    break;
-  default:
-    llvm::report_fatal_error("invalid RANDOM_SEED argument index");
+    argBox = get;
   }
-  mlir::FunctionType funcTy = func.getFunctionType();
-  mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
-  mlir::Value sourceLine =
-      fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
-  llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
-      builder, loc, funcTy, argBox, sourceFile, sourceLine);
+  funcTy = func.getFunctionType();
+  sourceLine = fir::factory::locationToLineNo(builder, loc, funcTy.getInput(2));
+  args = fir::runtime::createArguments(builder, loc, funcTy, argBox, sourceFile,
+                                       sourceLine);
   builder.create<fir::CallOp>(loc, func, args);
 }
 

diff  --git a/flang/runtime/random.cpp b/flang/runtime/random.cpp
index 0f6a6a2be623f..4b9946a7c413d 100644
--- a/flang/runtime/random.cpp
+++ b/flang/runtime/random.cpp
@@ -11,6 +11,7 @@
 
 #include "flang/Runtime/random.h"
 #include "lock.h"
+#include "terminator.h"
 #include "flang/Common/leading-zero-bit-count.h"
 #include "flang/Common/uint128.h"
 #include "flang/Runtime/cpp-type.h"
@@ -139,18 +140,23 @@ void RTNAME(RandomNumber)(
 }
 
 void RTNAME(RandomSeedSize)(
-    const Descriptor &size, const char *source, int line) {
+    const Descriptor *size, const char *source, int line) {
+  if (!size || !size->raw().base_addr) {
+    RTNAME(RandomSeedDefaultPut)();
+    return;
+  }
   Terminator terminator{source, line};
-  auto typeCode{size.type().GetCategoryAndKind()};
+  auto typeCode{size->type().GetCategoryAndKind()};
   RUNTIME_CHECK(terminator,
-      size.rank() == 0 && typeCode && typeCode->first == TypeCategory::Integer);
+      size->rank() == 0 && typeCode &&
+          typeCode->first == TypeCategory::Integer);
   int kind{typeCode->second};
   switch (kind) {
   case 4:
-    *size.OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>() = 1;
+    *size->OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>() = 1;
     break;
   case 8:
-    *size.OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>() = 1;
+    *size->OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>() = 1;
     break;
   default:
     terminator.Crash(
@@ -159,20 +165,25 @@ void RTNAME(RandomSeedSize)(
 }
 
 void RTNAME(RandomSeedPut)(
-    const Descriptor &put, const char *source, int line) {
+    const Descriptor *put, const char *source, int line) {
+  if (!put || !put->raw().base_addr) {
+    RTNAME(RandomSeedDefaultPut)();
+    return;
+  }
   Terminator terminator{source, line};
-  auto typeCode{put.type().GetCategoryAndKind()};
+  auto typeCode{put->type().GetCategoryAndKind()};
   RUNTIME_CHECK(terminator,
-      put.rank() == 1 && typeCode && typeCode->first == TypeCategory::Integer &&
-          put.GetDimension(0).Extent() >= 1);
+      put->rank() == 1 && typeCode &&
+          typeCode->first == TypeCategory::Integer &&
+          put->GetDimension(0).Extent() >= 1);
   int kind{typeCode->second};
   GeneratedWord seed;
   switch (kind) {
   case 4:
-    seed = *put.OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>();
+    seed = *put->OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>();
     break;
   case 8:
-    seed = *put.OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>();
+    seed = *put->OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>();
     break;
   default:
     terminator.Crash("not yet implemented: RANDOM_SEED(PUT=): kind %d\n", kind);
@@ -193,12 +204,17 @@ void RTNAME(RandomSeedDefaultPut)() {
 }
 
 void RTNAME(RandomSeedGet)(
-    const Descriptor &got, const char *source, int line) {
+    const Descriptor *get, const char *source, int line) {
+  if (!get || !get->raw().base_addr) {
+    RTNAME(RandomSeedDefaultPut)();
+    return;
+  }
   Terminator terminator{source, line};
-  auto typeCode{got.type().GetCategoryAndKind()};
+  auto typeCode{get->type().GetCategoryAndKind()};
   RUNTIME_CHECK(terminator,
-      got.rank() == 1 && typeCode && typeCode->first == TypeCategory::Integer &&
-          got.GetDimension(0).Extent() >= 1);
+      get->rank() == 1 && typeCode &&
+          typeCode->first == TypeCategory::Integer &&
+          get->GetDimension(0).Extent() >= 1);
   int kind{typeCode->second};
   GeneratedWord seed;
   {
@@ -208,14 +224,33 @@ void RTNAME(RandomSeedGet)(
   }
   switch (kind) {
   case 4:
-    *got.OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>() = seed;
+    *get->OffsetElement<CppTypeFor<TypeCategory::Integer, 4>>() = seed;
     break;
   case 8:
-    *got.OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>() = seed;
+    *get->OffsetElement<CppTypeFor<TypeCategory::Integer, 8>>() = seed;
     break;
   default:
     terminator.Crash("not yet implemented: RANDOM_SEED(GET=): kind %d\n", kind);
   }
 }
+
+void RTNAME(RandomSeed)(const Descriptor *size, const Descriptor *put,
+    const Descriptor *get, const char *source, int line) {
+  bool sizePresent = size && size->raw().base_addr;
+  bool putPresent = put && put->raw().base_addr;
+  bool getPresent = get && get->raw().base_addr;
+  if (sizePresent + putPresent + getPresent > 1)
+    Terminator{source, line}.Crash(
+        "RANDOM_SEED must have either 1 or no arguments");
+  if (sizePresent)
+    RTNAME(RandomSeedSize)(size, source, line);
+  else if (putPresent)
+    RTNAME(RandomSeedPut)(put, source, line);
+  else if (getPresent)
+    RTNAME(RandomSeedGet)(get, source, line);
+  else
+    RTNAME(RandomSeedDefaultPut)();
+}
+
 } // extern "C"
 } // namespace Fortran::runtime

diff  --git a/flang/test/Lower/Intrinsics/random.f90 b/flang/test/Lower/Intrinsics/random.f90
index 0f6c38e84759d..3f50394f4bd79 100644
--- a/flang/test/Lower/Intrinsics/random.f90
+++ b/flang/test/Lower/Intrinsics/random.f90
@@ -1,41 +1,97 @@
 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
 
-! CHECK-LABEL: func @_QPrandom_test
-subroutine random_test
-    ! CHECK-DAG: [[ss:%[0-9]+]] = fir.alloca {{.*}}random_testEss
-    ! CHECK-DAG: [[vv:%[0-9]+]] = fir.alloca {{.*}}random_testEvv
-    integer ss, vv(40)
-    ! CHECK-DAG: [[rr:%[0-9]+]] = fir.alloca {{.*}}random_testErr
-    ! CHECK-DAG: [[aa:%[0-9]+]] = fir.alloca {{.*}}random_testEaa
-    real rr, aa(5)
-    ! CHECK: fir.call @_FortranARandomInit(%true{{.*}}, %false{{.*}}) : (i1, i1) -> none
-    call random_init(.true., .false.)
-    ! CHECK: [[box:%[0-9]+]] = fir.embox [[ss]]
-    ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
-    ! CHECK: fir.call @_FortranARandomSeedSize([[argbox]]
-    call random_seed(size=ss)
-    print*, 'size: ', ss
-    ! CHECK: fir.call @_FortranARandomSeedDefaultPut() : () -> none
-    call random_seed()
-    ! CHECK: [[box:%[0-9]+]] = fir.embox [[rr]]
-    ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
-    ! CHECK: fir.call @_FortranARandomNumber([[argbox]]
-    call random_number(rr)
-    print*, rr
-    ! CHECK: [[box:%[0-9]+]] = fir.embox [[vv]]
-    ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
-    ! CHECK: fir.call @_FortranARandomSeedGet([[argbox]]
-    call random_seed(get=vv)
-  ! print*, 'get:  ', vv(1:ss)
-    ! CHECK: [[box:%[0-9]+]] = fir.embox [[vv]]
-    ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
-    ! CHECK: fir.call @_FortranARandomSeedPut([[argbox]]
-    call random_seed(put=vv)
-    print*, 'put:  ', vv(1:ss)
-    ! CHECK: [[box:%[0-9]+]] = fir.embox [[aa]]
-    ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
-    ! CHECK: fir.call @_FortranARandomNumber([[argbox]]
-    call random_number(aa)
-    print*, aa
-  end
-  
\ No newline at end of file
+! CHECK-LABEL: func @_QPrandom_test_1
+subroutine random_test_1
+  ! CHECK-DAG: [[ss:%[0-9]+]] = fir.alloca {{.*}}random_test_1Ess
+  ! CHECK-DAG: [[vv:%[0-9]+]] = fir.alloca {{.*}}random_test_1Evv
+  integer ss, vv(40)
+  ! CHECK-DAG: [[rr:%[0-9]+]] = fir.alloca {{.*}}random_test_1Err
+  ! CHECK-DAG: [[aa:%[0-9]+]] = fir.alloca {{.*}}random_test_1Eaa
+  real rr, aa(5)
+  ! CHECK: fir.call @_FortranARandomInit(%true{{.*}}, %false{{.*}}) : (i1, i1) -> none
+  call random_init(.true., .false.)
+  ! CHECK: [[box:%[0-9]+]] = fir.embox [[ss]]
+  ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
+  ! CHECK: fir.call @_FortranARandomSeedSize([[argbox]]
+  call random_seed(size=ss)
+  print*, 'size: ', ss
+  ! CHECK: fir.call @_FortranARandomSeedDefaultPut() : () -> none
+  call random_seed()
+  ! CHECK: [[box:%[0-9]+]] = fir.embox [[rr]]
+  ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
+  ! CHECK: fir.call @_FortranARandomNumber([[argbox]]
+  call random_number(rr)
+  print*, rr
+  ! CHECK: [[box:%[0-9]+]] = fir.embox [[vv]]
+  ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
+  ! CHECK: fir.call @_FortranARandomSeedGet([[argbox]]
+  call random_seed(get=vv)
+! print*, 'get:  ', vv(1:ss)
+  ! CHECK: [[box:%[0-9]+]] = fir.embox [[vv]]
+  ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
+  ! CHECK: fir.call @_FortranARandomSeedPut([[argbox]]
+  call random_seed(put=vv)
+  print*, 'put:  ', vv(1:ss)
+  ! CHECK: [[box:%[0-9]+]] = fir.embox [[aa]]
+  ! CHECK: [[argbox:%[0-9]+]] = fir.convert [[box]]
+  ! CHECK: fir.call @_FortranARandomNumber([[argbox]]
+  call random_number(aa)
+  print*, aa
+end
+
+! CHECK-LABEL: func @_QPrandom_test_2
+subroutine random_test_2
+  integer :: size, get(5) = -9
+  call foo(size)
+  call bar(size, get)
+contains
+  ! CHECK-LABEL: func @_QFrandom_test_2Pfoo
+  subroutine foo(size, put, get)
+    ! CHECK: [[s1:%[0-9]+]] = fir.is_present %arg0
+    ! CHECK: [[s2:%[0-9]+]] = fir.embox %arg0
+    ! CHECK: [[s3:%[0-9]+]] = fir.absent !fir.box<i32>
+    ! CHECK: [[s4:%[0-9]+]] = arith.select [[s1]], [[s2]], [[s3]] : !fir.box<i32>
+    integer, optional :: size
+    ! CHECK: [[p1:%[0-9]+]] = fir.is_present %arg1
+    ! CHECK: [[p2:%[0-9]+]] = fir.embox %arg1
+    ! CHECK: [[p3:%[0-9]+]] = fir.absent !fir.box<!fir.array<5xi32>>
+    ! CHECK: [[p4:%[0-9]+]] = arith.select [[p1]], [[p2]], [[p3]] : !fir.box<!fir.array<5xi32>>
+    integer, optional :: put(5)
+    ! CHECK: [[g1:%[0-9]+]] = fir.is_present %arg2
+    ! CHECK: [[g2:%[0-9]+]] = fir.embox %arg2
+    ! CHECK: [[g3:%[0-9]+]] = fir.absent !fir.box<!fir.array<5xi32>>
+    ! CHECK: [[g4:%[0-9]+]] = arith.select [[g1]], [[g2]], [[g3]] : !fir.box<!fir.array<5xi32>>
+    integer, optional :: get(5)
+    ! CHECK: [[s5:%[0-9]+]] = fir.convert [[s4]] : (!fir.box<i32>) -> !fir.box<none>
+    ! CHECK: [[p5:%[0-9]+]] = fir.convert [[p4]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+    ! CHECK: [[g5:%[0-9]+]] = fir.convert [[g4]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+    ! CHECK: fir.call @_FortranARandomSeed([[s5]], [[p5]], [[g5]]
+    call random_seed(size, put, get)
+    print*, size
+  end subroutine
+
+  ! CHECK-LABEL: func @_QFrandom_test_2Pbar
+  subroutine bar(size, get, put)
+    integer, optional :: size
+    ! CHECK: [[p1:%[0-9]+]] = fir.is_present %arg2
+    ! CHECK: [[p2:%[0-9]+]] = fir.embox %arg2
+    ! CHECK: [[p3:%[0-9]+]] = fir.absent !fir.box<!fir.array<5xi32>>
+    ! CHECK: [[p4:%[0-9]+]] = arith.select [[p1]], [[p2]], [[p3]] : !fir.box<!fir.array<5xi32>>
+    integer, optional :: put(5)
+    ! CHECK: [[g1:%[0-9]+]] = fir.is_present %arg1
+    ! CHECK: [[g2:%[0-9]+]] = fir.embox %arg1
+    ! CHECK: [[g3:%[0-9]+]] = fir.absent !fir.box<!fir.array<5xi32>>
+    ! CHECK: [[g4:%[0-9]+]] = arith.select [[g1]], [[g2]], [[g3]] : !fir.box<!fir.array<5xi32>>
+    integer, optional :: get(5)
+    ! CHECK: [[s1:%[0-9]+]] = fir.absent !fir.box<none>
+    ! CHECK: [[p5:%[0-9]+]] = fir.convert [[p4]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+    ! CHECK: [[g5:%[0-9]+]] = fir.convert [[g4]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>
+    ! CHECK: fir.call @_FortranARandomSeed([[s1]], [[p5]], [[g5]]
+    call random_seed(put=put, get=get)
+    print*, get(1:size+1) ! "extra" value should be -9
+  end subroutine
+end
+
+  call random_test_1
+  call random_test_2
+end

diff  --git a/flang/unittests/Runtime/Random.cpp b/flang/unittests/Runtime/Random.cpp
index 27fac89f14509..cb739b9451429 100644
--- a/flang/unittests/Runtime/Random.cpp
+++ b/flang/unittests/Runtime/Random.cpp
@@ -47,17 +47,17 @@ TEST(RandomNumber, RandomSeed) {
   Descriptor &desc{statDesc[0].descriptor()};
   std::int32_t n;
   desc.Establish(TypeCategory::Integer, 4, &n, 0, nullptr);
-  RTNAME(RandomSeedSize)(desc, __FILE__, __LINE__);
+  RTNAME(RandomSeedSize)(&desc, __FILE__, __LINE__);
   EXPECT_EQ(n, 1);
   SubscriptValue extent[1]{1};
   desc.Establish(TypeCategory::Integer, 4, &n, 1, extent);
-  RTNAME(RandomSeedGet)(desc, __FILE__, __LINE__);
+  RTNAME(RandomSeedGet)(&desc, __FILE__, __LINE__);
   Descriptor &harvest{statDesc[1].descriptor()};
   float x;
   harvest.Establish(TypeCategory::Real, 4, &x, 1, extent);
   RTNAME(RandomNumber)(harvest, __FILE__, __LINE__);
   float got{x};
-  RTNAME(RandomSeedPut)(desc, __FILE__, __LINE__); // n from RandomSeedGet()
+  RTNAME(RandomSeedPut)(&desc, __FILE__, __LINE__); // n from RandomSeedGet()
   RTNAME(RandomNumber)(harvest, __FILE__, __LINE__);
   EXPECT_EQ(x, got);
 }


        


More information about the flang-commits mailing list