[PATCH] D104318: [flang] Add semantic check for the RANDOM_SEED intrinsic
Pete Steinfeld via Phabricator via llvm-commits
llvm-commits at lists.llvm.org
Tue Jun 15 13:11:02 PDT 2021
PeteSteinfeld created this revision.
Herald added a reviewer: sscalpone.
PeteSteinfeld requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.
I added the only check that wasn't already tested along with tests for
many valid and invalid arguments.
Repository:
rG LLVM Github Monorepo
https://reviews.llvm.org/D104318
Files:
flang/lib/Evaluate/intrinsics.cpp
flang/test/Semantics/random-seed.f90
Index: flang/test/Semantics/random-seed.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/random-seed.f90
@@ -0,0 +1,29 @@
+! RUN: %S/test_errors.sh %s %t %flang_fc1
+! REQUIRES: shell
+! NULL() intrinsic function error tests
+program test_random_seed
+ integer :: size_arg
+ integer, parameter :: size_arg_const = 343
+ integer, dimension(3), parameter :: put_arg = [9,8,7]
+ integer :: get_arg_scalar
+ integer, dimension(3) :: get_arg
+ integer, dimension(3),parameter :: get_arg_const = [8,7,6]
+ call random_seed()
+ call random_seed(size_arg)
+ call random_seed(size=size_arg)
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'size=' must be definable
+ call random_seed(size_arg_const) ! error, size arg must be definable
+ !ERROR: 'size=' argument has unacceptable rank 1
+ call random_seed([1, 2, 3, 4]) ! Error, must be a scalar
+ call random_seed(put = [1, 2, 3, 4])
+ call random_seed(put = put_arg)
+ !ERROR: 'size=' argument has unacceptable rank 1
+ call random_seed(get_arg) ! Error, must be a scalar
+ call random_seed(get=get_arg)
+ !ERROR: 'get=' argument has unacceptable rank 0
+ call random_seed(get=get_arg_scalar) ! Error, GET arg must be of rank 1
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'get=' must be definable
+ call random_seed(get=get_arg_const) ! Error, GET arg must be definable
+ !ERROR: RANDOM_SEED must have either 1 or no arguments
+ call random_seed(size_arg, get_arg) ! Error, only 0 or 1 argument
+end program
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -1102,9 +1102,7 @@
{"put", DefaultInt, Rank::vector, Optionality::optional},
{"get", DefaultInt, Rank::vector, Optionality::optional,
common::Intent::Out}},
- {}, Rank::elemental,
- IntrinsicClass::impureSubroutine}, // TODO: at most one argument can be
- // present
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"system_clock",
{{"count", AnyInt, Rank::scalar, Optionality::optional,
common::Intent::Out},
@@ -2167,15 +2165,18 @@
FoldingContext &context, const IntrinsicProcTable &intrinsics) const {
// All special cases handled here before the table probes below must
- // also be recognized as special names in IsIntrinsic().
+ // also be recognized as special names in IsIntrinsicSubroutine().
if (call.isSubroutineCall) {
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) {
+ context.messages().Say(
+ "RANDOM_SEED must have either 1 or no arguments"_err_en_US);
+ }
}
- } else {
- if (call.name == "null") {
- return HandleNull(arguments, context);
- }
+ } else if (call.name == "null") {
+ return HandleNull(arguments, context);
}
if (call.isSubroutineCall) {
-------------- next part --------------
A non-text attachment was scrubbed...
Name: D104318.352227.patch
Type: text/x-patch
Size: 3211 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210615/085513e3/attachment.bin>
More information about the llvm-commits
mailing list