From ddd3e26e42b8d55989f9964c6ec6ee50b30b1802 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Fri, 1 Jun 2018 17:05:02 +0000 Subject: [PATCH] re PR fortran/63570 ([F2018] Implement 13.7.137 RANDOM INIT (REPEATABLE, IMAGE DISTINCT)) 2018-06-01 Steven G. Kargl 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 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 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 --- gcc/fortran/ChangeLog | 19 +++++ gcc/fortran/check.c | 21 +++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/intrinsic.c | 6 ++ gcc/fortran/intrinsic.h | 2 + gcc/fortran/intrinsic.texi | 59 ++++++++++++- gcc/fortran/iresolve.c | 11 +++ gcc/fortran/trans-decl.c | 7 ++ gcc/fortran/trans-intrinsic.c | 50 +++++++++++ gcc/fortran/trans.h | 2 + gcc/testsuite/ChangeLog | 10 +++ gcc/testsuite/gfortran.dg/random_init_1.f90 | 11 +++ gcc/testsuite/gfortran.dg/random_init_2.f90 | 30 +++++++ gcc/testsuite/gfortran.dg/random_init_3.f90 | 74 ++++++++++++++++ gcc/testsuite/gfortran.dg/random_init_4.f90 | 43 ++++++++++ gcc/testsuite/gfortran.dg/random_init_5.f90 | 43 ++++++++++ gcc/testsuite/gfortran.dg/random_init_6.f90 | 43 ++++++++++ libgfortran/ChangeLog | 8 ++ libgfortran/Makefile.am | 3 +- libgfortran/Makefile.in | 8 +- libgfortran/gfortran.map | 1 + libgfortran/intrinsics/random_init.f90 | 94 +++++++++++++++++++++ 22 files changed, 541 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/random_init_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/random_init_6.f90 create mode 100644 libgfortran/intrinsics/random_init.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 95914aea938..272a94eadc3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2018-06-01 Steven G. Kargl + + 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-05-27 Steven G. Kargl * decl.c (match_data_constant): Fortran 2018 allows pointer diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 8d41fcd292f..30214fef4c7 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -5786,6 +5786,27 @@ gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len, } +/* Check the arguments for RANDOM_INIT. */ + +bool +gfc_check_random_init (gfc_expr *repeatable, gfc_expr *image_distinct) +{ + if (!type_check (repeatable, 0, BT_LOGICAL)) + return false; + + if (!scalar_check (repeatable, 0)) + return false; + + if (!type_check (image_distinct, 1, BT_LOGICAL)) + return false; + + if (!scalar_check (image_distinct, 1)) + return false; + + return true; +} + + bool gfc_check_random_number (gfc_expr *harvest) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4c4e7afbec1..b7eaa0e35ab 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -553,6 +553,7 @@ enum gfc_isym_id GFC_ISYM_PRODUCT, GFC_ISYM_RADIX, GFC_ISYM_RAND, + GFC_ISYM_RANDOM_INIT, GFC_ISYM_RANDOM_NUMBER, GFC_ISYM_RANDOM_SEED, GFC_ISYM_RANGE, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 8dd135f6b42..609668613a7 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -3568,6 +3568,12 @@ add_subroutines (void) make_alias ("kmvbits", GFC_STD_GNU); } + add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE, + BT_UNKNOWN, 0, GFC_STD_F2018, + gfc_check_random_init, NULL, gfc_resolve_random_init, + "repeatable", BT_LOGICAL, dl, REQUIRED, INTENT_IN, + "image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN); + add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL, gfc_resolve_random_number, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index a483bfa0c7b..7a957d39239 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -205,6 +205,7 @@ bool gfc_check_getlog (gfc_expr *); bool gfc_check_move_alloc (gfc_expr *, gfc_expr *); bool gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_random_init (gfc_expr *, gfc_expr *); bool gfc_check_random_number (gfc_expr *); bool gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *); @@ -653,6 +654,7 @@ void gfc_resolve_lstat_sub (gfc_code *); void gfc_resolve_ltime (gfc_code *); void gfc_resolve_mvbits (gfc_code *); void gfc_resolve_perror (gfc_code *); +void gfc_resolve_random_init (gfc_code *); void gfc_resolve_random_number (gfc_code *); void gfc_resolve_random_seed (gfc_code *); void gfc_resolve_rename_sub (gfc_code *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index adea02a78e5..ca006c96c5f 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -262,6 +262,7 @@ Some basic guidelines for editing this document: * @code{RADIX}: RADIX, Base of a data model * @code{RAN}: RAN, Real pseudo-random number * @code{RAND}: RAND, Real pseudo-random number +* @code{RANDOM_INIT}: RANDOM_INIT, Initialize pseudo-random number generator * @code{RANDOM_NUMBER}: RANDOM_NUMBER, Pseudo-random number * @code{RANDOM_SEED}: RANDOM_SEED, Initialize a pseudo-random number sequence * @code{RANGE}: RANGE, Decimal exponent range @@ -11598,6 +11599,60 @@ end program test_rand @end table +@node RANDOM_INIT +@section @code{RANDOM_INIT} --- Initialize a pseudo-random number generator +@fnindex RANDOM_INIT +@cindex random number generation, initialization + +@table @asis +@item @emph{Description}: +Initializes the state of the pseudorandom number generator used by +@code{RANDOM_NUMBER}. + +@item @emph{Standard}: +Fortran 2018 + +@item @emph{Class}: +Subroutine + +@item @emph{Syntax}: +@code{CALL RANDOM_INIT(REPEATABLE, IMAGE_DISTINCT)} + +@item @emph{Arguments}: +@multitable @columnfractions .20 .75 +@item @var{REPEATABLE} @tab Shall be a scalar with a @code{LOGICAL} type, +and it is @code{INTENT(IN)}. If it is @code{.true.}, the seed is set to +a processor-dependent value that is the same each time @code{RANDOM_INIT} +is called from the same image. The term ``same image'' means a single +instance of program execution. The sequence of random numbers is different +for repeated execution of the program. If it is @code{.false.}, the seed +is set to a processor-dependent value. +@item @var{IMAGE_DISTINCT} @tab Shall be a scalar with a +@code{LOGICAL} type, and it is @code{INTENT(IN)}. If it is @code{.true.}, +the seed is set to a processor-dependent value that is distinct from th +seed set by a call to @code{RANDOM_INIT} in another image. If it is +@code{.false.}, the seed is set value that does depend which image called +@code{RANDOM_INIT}. +@end multitable + +@item @emph{Example}: +@smallexample +program test_random_seed + implicit none + real x(3), y(3) + call random_init(.true., .true.) + call random_number(x) + call random_init(.true., .true.) + call random_number(y) + ! x and y are the same sequence + if (any(x /= y)) call abort +end program test_random_seed +@end smallexample + +@item @emph{See also}: +@ref{RANDOM_NUMBER}, @ref{RANDOM_SEED} +@end table + @node RANDOM_NUMBER @section @code{RANDOM_NUMBER} --- Pseudo-random number @@ -11643,7 +11698,7 @@ end program @end smallexample @item @emph{See also}: -@ref{RANDOM_SEED} +@ref{RANDOM_SEED}, @ref{RANDOM_INIT} @end table @@ -11713,7 +11768,7 @@ end program test_random_seed @end smallexample @item @emph{See also}: -@ref{RANDOM_NUMBER} +@ref{RANDOM_NUMBER}, @ref{RANDOM_INIT} @end table diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index f15b8f2773a..2eb8f7c9113 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -3404,6 +3404,17 @@ gfc_resolve_mvbits (gfc_code *c) } +/* Set up the call to RANDOM_INIT. */ + +void +gfc_resolve_random_init (gfc_code *c) +{ + const char *name; + name = gfc_get_string (PREFIX ("random_init")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + void gfc_resolve_random_number (gfc_code *c) { diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6c4a2214ce7..cd23c2d5eae 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -229,6 +229,8 @@ tree gfor_fndecl_dgemm; tree gfor_fndecl_cgemm; tree gfor_fndecl_zgemm; +/* RANDOM_INIT function. */ +tree gfor_fndecl_random_init; static void gfc_add_decl_to_parent_function (tree decl) @@ -3328,6 +3330,11 @@ gfc_build_intrinsic_function_decls (void) void_type_node, 3, pchar_type_node, gfc_charlen_type_node, gfc_int8_type_node); + gfor_fndecl_random_init = gfc_build_library_function_decl ( + get_identifier (PREFIX("random_init")), + void_type_node, 3, gfc_logical4_type_node, gfc_logical4_type_node, + gfc_int4_type_node); + gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("selected_char_kind")), "..R", gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index fa019716292..d306e3a5a62 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; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index c6b362542de..049fcd6cd49 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -915,6 +915,8 @@ extern GTY(()) tree gfor_fndecl_sr_kind; extern GTY(()) tree gfor_fndecl_ieee_procedure_entry; extern GTY(()) tree gfor_fndecl_ieee_procedure_exit; +/* RANDOM_INIT. */ +extern GTY(()) tree gfor_fndecl_random_init; /* True if node is an integer constant. */ #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 050e7545ac1..0ccd0ab2dd9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2018-06-01 Steven G. Kargl + + 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 Richard Sandiford PR tree-optimization/85989 diff --git a/gcc/testsuite/gfortran.dg/random_init_1.f90 b/gcc/testsuite/gfortran.dg/random_init_1.f90 new file mode 100644 index 00000000000..1de2f6ec527 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_1.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +program foo + logical a(2) + real x + call random_init(1., .false.) ! { dg-error "must be LOGICAL" } + call random_init(.true., 1) ! { dg-error "must be LOGICAL" } + call random_number(x) + a = .true. + call random_init(a, .false.) ! { dg-error "must be a scalar" } + call random_init(.false., a) ! { dg-error "must be a scalar" } +end program foo diff --git a/gcc/testsuite/gfortran.dg/random_init_2.f90 b/gcc/testsuite/gfortran.dg/random_init_2.f90 new file mode 100644 index 00000000000..dc7036009d3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_2.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +program foo + + real x(2), y(2) + + call random_init(.false., .false.) + call random_number(x) +! print *, x + x = int(1e6*x) + + call random_init(.false., .false.) + call random_number(y) +! print *, y + y = int(1e6*y) + + if (any(x == y)) call abort + + call random_init(.true., .false.) + call random_number(x) +! print *, x + x = int(1e6*x) + + call random_init(.true., .false.) + call random_number(y) +! print *, y + y = int(1e6*y) + + if (any(x /= y)) call abort + +end program foo diff --git a/gcc/testsuite/gfortran.dg/random_init_3.f90 b/gcc/testsuite/gfortran.dg/random_init_3.f90 new file mode 100644 index 00000000000..2802dadb876 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_3.f90 @@ -0,0 +1,74 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +program rantest + + implicit none + + logical, parameter :: debug = .false. + character(len=20) name + integer fd, i, n + integer, allocatable :: n1(:), n2(:), n3(:) + real x(4), y(4), z(4) + + if (debug) then + write(name,'(A,I0)') 'dat', this_image() + open(newunit=fd, file=name) + end if + + call random_seed(size=n) + allocate(n1(n), n2(n), n3(n)) + ! + ! Setup repeatable sequences (if co-arrays the seeds should be distinct + ! are different). Get the seeds. + ! + call random_init(.true., .true.) + call random_seed(get=n1) + call random_number(x) ! This changes internal state. + if (debug) then + write(fd,'(A,4F12.6)') 'x = ', x + end if + + call random_seed(get=n2) ! Grab current state. + ! + ! Use the gotten seed to reseed PRNG and grab sequence. + ! It should be the same sequence. + ! + call random_seed(put=n1) + call random_number(y) + if (debug) then + write(fd,'(A,4F12.6)') 'y = ', y + end if + ! + ! Setup repeatable sequences (if co-arrays the seeds should be distinct + ! are different). Get the seeds. It should be the same sequence. + ! + call random_init(.true., .true.) + call random_seed(get=n3) + call random_number(z) + if (debug) then + write(fd,'(A,4F12.6)') 'z = ', z + end if + + x = int(1e6*x) ! Convert to integer with at most 6 digits. + y = int(1e6*y) ! Convert to integer with at most 6 digits. + z = int(1e6*z) ! Convert to integer with at most 6 digits. + + if (any(x /= y)) call abort + if (any(x /= z)) call abort + + if (debug) then + write(fd,*) + do i = 1, n + if (n1(i) - n2(i) /= 0) then + write(fd,*) 'n1 /= n2', i, n1(i), n2(i) + end if + end do + write(fd,*) + do i = 1, n + if (n1(i) - n3(i) /= 0) then + write(fd,*) 'n1 /= n3', i, n1(i), n3(i) + end if + end do + end if + +end program rantest diff --git a/gcc/testsuite/gfortran.dg/random_init_4.f90 b/gcc/testsuite/gfortran.dg/random_init_4.f90 new file mode 100644 index 00000000000..b3a35f93fa1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_4.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +program rantest + + implicit none + + logical, parameter :: debug = .false. + character(len=20) name + integer fd, i, n + integer, allocatable :: n1(:), n2(:), n3(:) + real x(4), y(4), z(4) + + if (debug) then + write(name,'(A,I0)') 'dat', this_image() + open(newunit=fd, file=name) + end if + + call random_seed(size=n) + allocate(n1(n), n2(n), n3(n)) + + call random_init(.true., .false.) + call random_seed(get=n1) + call random_number(x) + + call random_init(.true., .false.) + call random_seed(get=n2) + call random_number(y) + + call random_init(.true., .false.) + call random_seed(get=n3) + call random_number(z) + + if (debug) then + write(fd,'(A,4F12.6)') 'x = ', x + write(fd,'(A,4F12.6)') 'y = ', y + write(fd,'(A,4F12.6)') 'z = ', z + write(fd,*) + do i = 1, 5 + write(fd,'(I2,4I13)') i, n1(i), n2(i), n3(i) + end do + end if + +end program rantest diff --git a/gcc/testsuite/gfortran.dg/random_init_5.f90 b/gcc/testsuite/gfortran.dg/random_init_5.f90 new file mode 100644 index 00000000000..e9a200b14da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_5.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +program rantest + + implicit none + + logical, parameter :: debug = .false. + character(len=20) name + integer fd, i, n + integer, allocatable :: n1(:), n2(:), n3(:) + real x(4), y(4), z(4) + + if (debug) then + write(name,'(A,I0)') 'dat', this_image() + open(newunit=fd, file=name) + end if + + call random_seed(size=n) + allocate(n1(n), n2(n), n3(n)) + + call random_init(.false., .false.) + call random_seed(get=n1) + call random_number(x) + + call random_init(.false., .false.) + call random_seed(get=n2) + call random_number(y) + + call random_init(.false., .false.) + call random_seed(get=n3) + call random_number(z) + + if (debug) then + write(fd,'(A,4F12.6)') 'x = ', x + write(fd,'(A,4F12.6)') 'y = ', y + write(fd,'(A,4F12.6)') 'z = ', z + write(fd,*) + do i = 1, 5 + write(fd,'(I2,4I13)') i, n1(i), n2(i), n3(i) + end do + end if + +end program rantest diff --git a/gcc/testsuite/gfortran.dg/random_init_6.f90 b/gcc/testsuite/gfortran.dg/random_init_6.f90 new file mode 100644 index 00000000000..e8d91d8accf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_init_6.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +program rantest + + implicit none + + logical, parameter :: debug = .false. + character(len=20) name + integer fd, i, n + integer, allocatable :: n1(:), n2(:), n3(:) + real x(4), y(4), z(4) + + if (debug) then + write(name,'(A,I0)') 'dat', this_image() + open(newunit=fd, file=name) + end if + + call random_seed(size=n) + allocate(n1(n), n2(n), n3(n)) + + call random_init(.false., .true.) + call random_seed(get=n1) + call random_number(x) + + call random_init(.false., .true.) + call random_seed(get=n2) + call random_number(y) + + call random_init(.false., .true.) + call random_seed(get=n3) + call random_number(z) + + if (debug) then + write(fd,'(A,4F12.6)') 'x = ', x + write(fd,'(A,4F12.6)') 'y = ', y + write(fd,'(A,4F12.6)') 'z = ', z + write(fd,*) + do i = 1, 5 + write(fd,'(I2,4I13)') i, n1(i), n2(i), n3(i) + end do + end if + +end program rantest diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c0b0f859711..a220cc864b5 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2018-06-01 Steven G. Kargl + + 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. + 2018-05-28 Jerry DeLisle PR libgfortran/85840 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index bf9dce40593..5831631ddfb 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -915,7 +915,8 @@ $(gfor_built_specific_src) \ $(gfor_built_specific2_src) \ $(gfor_misc_specifics) \ intrinsics/dprod_r8.f90 \ -intrinsics/f2c_specifics.F90 +intrinsics/f2c_specifics.F90 \ +intrinsics/random_init.f90 # Turn on vectorization and loop unrolling for matmul. $(patsubst %.c,%.lo,$(notdir $(i_matmul_c))): AM_CFLAGS += -ffast-math -ftree-vectorize -funroll-loops --param max-unroll-times=4 diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 03c3968732a..b66a91bfde3 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -408,7 +408,7 @@ am__objects_56 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \ _mod_r10.lo _mod_r16.lo am__objects_57 = misc_specifics.lo am__objects_58 = $(am__objects_55) $(am__objects_56) $(am__objects_57) \ - dprod_r8.lo f2c_specifics.lo + dprod_r8.lo f2c_specifics.lo random_init.lo am__objects_59 = $(am__objects_3) $(am__objects_47) $(am__objects_49) \ $(am__objects_52) $(am__objects_53) $(am__objects_54) \ $(am__objects_58) @@ -1374,7 +1374,8 @@ $(gfor_built_specific_src) \ $(gfor_built_specific2_src) \ $(gfor_misc_specifics) \ intrinsics/dprod_r8.f90 \ -intrinsics/f2c_specifics.F90 +intrinsics/f2c_specifics.F90 \ +intrinsics/random_init.f90 BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \ $(gfor_built_specific2_src) $(gfor_misc_specifics) \ @@ -6230,6 +6231,9 @@ selected_real_kind.lo: intrinsics/selected_real_kind.f90 dprod_r8.lo: intrinsics/dprod_r8.f90 $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o dprod_r8.lo `test -f 'intrinsics/dprod_r8.f90' || echo '$(srcdir)/'`intrinsics/dprod_r8.f90 +random_init.lo: intrinsics/random_init.f90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o random_init.lo `test -f 'intrinsics/random_init.f90' || echo '$(srcdir)/'`intrinsics/random_init.f90 + mostlyclean-libtool: -rm -f *.lo diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 29af0dc3619..78f8d7e9706 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -799,6 +799,7 @@ GFORTRAN_8 { _gfortran_product_r4; _gfortran_product_r8; _gfortran_rand; + _gfortran_random_init; _gfortran_random_r10; _gfortran_random_r16; _gfortran_random_r4; diff --git a/libgfortran/intrinsics/random_init.f90 b/libgfortran/intrinsics/random_init.f90 new file mode 100644 index 00000000000..edea0b89c4e --- /dev/null +++ b/libgfortran/intrinsics/random_init.f90 @@ -0,0 +1,94 @@ +! Copyright (C) 2018 Free Software Foundation, Inc. +! Contributed by Steven G. Kargl +! +! This file is part of the GNU Fortran runtime library (libgfortran). +! +! Libgfortran is free software; you can redistribute it and/or +! modify it under the terms of the GNU General Public +! License as published by the Free Software Foundation; either +! version 3 of the License, or (at your option) any later version. +! +! Libgfortran is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! Under Section 7 of GPL version 3, you are granted additional +! permissions described in the GCC Runtime Library Exception, version +! 3.1, as published by the Free Software Foundation. +! +! You should have received a copy of the GNU General Public License and +! a copy of the GCC Runtime Library Exception along with this program; +! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +! . +! +! +! WARNING: This file should never be compiled with an option that changes +! default logical kind from 4 to some other value or changes default integer +! kind from from 4 to some other value. +! +! +! There are four combinations of repeatable and image_distinct. If a program +! is compiled without the -fcoarray= option or with -fcoarray=single, then +! execution of the compiled executable does not use image_distinct as it is +! irrelevant (although required). The behavior is as follows: +! +! call random_init(.true., .true.) +! +! The sequence of random numbers is repeatable within an instance of program +! execution. That is, calls to random_init(.true., .true.) during the +! execution will reset the sequence of RN to the same sequence. If the +! program is compiled with -fcoarray=lib and multiple images are instantiated, +! then each image accesses a repeatable distinct sequence of random numbers. +! There are no guarantees that multiple execution of the program will access +! the same sequence. +! +! call random_init(.false., .false.) +! call random_init(.false., .true.) +! +! The sequence of random numbers is determined from process-dependent seeds. +! On each execution of the executable, different seeds will be used. For +! -fcoarray=lib and multiple instantiated images, each image will use +! process-dependent seeds. In other words, the two calls have identical +! behavior. +! +! call random_init(.true., .false.) +! +! For a program compiled without the -fcoarray= option or with +! -fcoarray=single, a single image is instantiated when the executable is +! run. If the executable causes multiple images to be instantiated, then +! image_distinct=.false. in one image cannot affect the sequence of random +! numbers in another image. As gfortran gives each image its own independent +! PRNG, this condition is automatically satisfied. +! +impure subroutine _gfortran_random_init(repeatable, image_distinct, hidden) + + implicit none + + logical, value, intent(in) :: repeatable + logical, value, intent(in) :: image_distinct + integer, value, intent(in) :: hidden + + logical, save :: once = .true. + integer :: nseed + integer, save, allocatable :: seed(:) + + if (once) then + once = .false. + call random_seed(size=nseed) + allocate(seed(nseed)) + call random_seed(get=seed) + ! + ! To guarantee that seed is distinct on multiple images, add the hidden + ! argument (which is the image index). + ! + if (image_distinct) seed = seed + hidden + end if + + if (repeatable) then + call random_seed(put=seed); + else + call random_seed(); + end if + +end subroutine _gfortran_random_init -- 2.30.2