[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