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

17 files changed, 430 insertions, 2 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 95914ae..272a94e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+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-05-27  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	* decl.c (match_data_constant):  Fortran 2018 allows pointer
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 8d41fcd..30214fe 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 4c4e7af..b7eaa0e 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 8dd135f..6096686 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 a483bfa..7a957d3 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 adea02a..ca006c9 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 f15b8f2..2eb8f7c 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 6c4a221..cd23c2d 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 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;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index c6b3625..049fcd6 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 050e754..0ccd0ab 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+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  Richard Sandiford  <richard.sandiford@linaro.org>
 
 	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 0000000..1de2f6e
--- /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 0000000..dc70360
--- /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 0000000..2802dad
--- /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 0000000..b3a35f9
--- /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 0000000..e9a200b1
--- /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 0000000..e8d91d8
--- /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