aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-intrinsic.c
diff options
context:
space:
mode:
authorSteven G. Kargl <kargl@gcc.gnu.org>2018-06-01 17:05:02 +0000
committerSteven G. Kargl <kargl@gcc.gnu.org>2018-06-01 17:05:02 +0000
commitddd3e26e42b8d55989f9964c6ec6ee50b30b1802 (patch)
tree0bf61ebd5153e8a07d2e13d7f8dc20fc8dfbcfea /gcc/fortran/trans-intrinsic.c
parent77b8fb05b3ae9223abb7bac05d8af6892cfa251a (diff)
downloadgcc-ddd3e26e42b8d55989f9964c6ec6ee50b30b1802.zip
gcc-ddd3e26e42b8d55989f9964c6ec6ee50b30b1802.tar.gz
gcc-ddd3e26e42b8d55989f9964c6ec6ee50b30b1802.tar.bz2
re PR fortran/63570 ([F2018] Implement 13.7.137 RANDOM INIT (REPEATABLE, IMAGE DISTINCT))
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/63570 * check.c (gfc_check_random_init): New function. Check arguments of RANDOM_INIT. * gfortran.h (GFC_ISYM_RANDOM_INIT): New enum token. * intrinsic.c (add_subroutines): Add RANDOM_INIT to list of subroutines. (gfc_check_intrinsic_standard): Introduce Fortran 2018 check. * intrinsic.h: Add prototypes for gfc_check_random_init and gfc_resolve_random_init * intrinsic.texi: Document new intrinsic subprogram. * iresolve.c (gfc_resolve_random_init): Resolve routine name. * trans-decl.c: Declare gfor_fndecl_random_init * trans-intrinsic.c (conv_intrinsic_random_init): New function. Translate call to RANDOM_INIT. (gfc_conv_intrinsic_subroutine): Call it. * trans.h: Declare gfor_fndecl_random_init 2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/63570 * gfortran.dg/random_init_1.f90: New test. * gfortran.dg/random_init_2.f90: New test. * gfortran.dg/random_init_3.f90: New test. * gfortran.dg/random_init_4.f90: New test. * gfortran.dg/random_init_5.f90: New test. * gfortran.dg/random_init_6.f90: New test. 2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/63570 * libgfortran/Makefile.am: Add random_init.f90 to build. * libgfortran/Makefile.in: Regenerated. * libgfortran/gfortran.map: Expose symbol for _gfortran_random_init. * libgfortran/intrinsics/random_init.f90: Implementation. From-SVN: r261075
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
-rw-r--r--gcc/fortran/trans-intrinsic.c50
1 files changed, 50 insertions, 0 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index fa01971..d306e3a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3635,6 +3635,52 @@ conv_intrinsic_free (gfc_code *code)
}
+/* Call the RANDOM_INIT library subroutine with a hidden argument for
+ handling seeding on coarray images. */
+
+static tree
+conv_intrinsic_random_init (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_se se;
+ tree arg1, arg2, arg3, tmp;
+ tree logical4_type_node = gfc_get_logical_type (4);
+
+ /* Make the function call. */
+ gfc_init_block (&block);
+ gfc_init_se (&se, NULL);
+
+ /* Convert REPEATABLE to a LOGICAL(4) entity. */
+ gfc_conv_expr (&se, code->ext.actual->expr);
+ gfc_add_block_to_block (&block, &se.pre);
+ arg1 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block));
+ gfc_add_block_to_block (&block, &se.post);
+
+ /* Convert IMAGE_DISTINCT to a LOGICAL(4) entity. */
+ gfc_conv_expr (&se, code->ext.actual->next->expr);
+ gfc_add_block_to_block (&block, &se.pre);
+ arg2 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block));
+ gfc_add_block_to_block (&block, &se.post);
+
+ /* Create the hidden argument. For non-coarray codes and -fcoarray=single,
+ simply set this to 0. For -fcoarray=lib, generate a call to
+ THIS_IMAGE() without arguments. */
+ arg3 = build_int_cst (gfc_get_int_type (4), 0);
+ if (flag_coarray == GFC_FCOARRAY_LIB)
+ {
+ arg3 = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image,
+ 1, arg3);
+ se.expr = fold_convert (gfc_get_int_type (4), arg3);
+ }
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_random_init, 3,
+ arg1, arg2, arg3);
+ gfc_add_expr_to_block (&block, tmp);
+
+ return gfc_finish_block (&block);
+}
+
+
/* Call the SYSTEM_CLOCK library functions, handling the type and kind
conversions. */
@@ -11064,6 +11110,10 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
res = conv_intrinsic_free (code);
break;
+ case GFC_ISYM_RANDOM_INIT:
+ res = conv_intrinsic_random_init (code);
+ break;
+
case GFC_ISYM_KILL:
res = conv_intrinsic_kill_sub (code);
break;