diff options
author | Steven G. Kargl <kargl@gcc.gnu.org> | 2018-06-01 17:05:02 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2018-06-01 17:05:02 +0000 |
commit | ddd3e26e42b8d55989f9964c6ec6ee50b30b1802 (patch) | |
tree | 0bf61ebd5153e8a07d2e13d7f8dc20fc8dfbcfea /gcc/fortran/trans-intrinsic.c | |
parent | 77b8fb05b3ae9223abb7bac05d8af6892cfa251a (diff) | |
download | gcc-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.c | 50 |
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; |