PR fortran/30964

	PR fortran/33054

	* trans-expr.c (gfc_conv_function_call): When no formal argument
	list is available, we still substitute missing optional arguments.
	* check.c (gfc_check_random_seed): Correct the check on the
	number of arguments to RANDOM_SEED.
	* intrinsic.c (add_subroutines): Add a resolution function to
	RANDOM_SEED.
	* iresolve.c (gfc_resolve_random_seed): New function.
	* intrinsic.h (gfc_resolve_random_seed): New prototype.

	* intrinsics/random.c (random_seed): Rename into random_seed_i4.
	(random_seed_i8): New function.
	* gfortran.map (GFORTRAN_1.0): Remove _gfortran_random_seed,
	add _gfortran_random_seed_i4 and _gfortran_random_seed_i8.
	* libgfortran.h (iexport_proto): Replace random_seed by
	random_seed_i4 and random_seed_i8.
	* runtime/main.c (init): Call the new random_seed_i4.

	* gfortran.dg/random_4.f90: New test.
	* gfortran.dg/random_5.f90: New test.
	* gfortran.dg/random_6.f90: New test.
	* gfortran.dg/random_7.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127383 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6e5c9e..acbe9a7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,18 @@
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 

+       PR fortran/30964
+       PR fortran/33054
+       * trans-expr.c (gfc_conv_function_call): When no formal argument
+       list is available, we still substitute missing optional arguments.
+       * check.c (gfc_check_random_seed): Correct the check on the
+       number of arguments to RANDOM_SEED.
+       * intrinsic.c (add_subroutines): Add a resolution function to
+       RANDOM_SEED.
+       * iresolve.c (gfc_resolve_random_seed): New function.
+       * intrinsic.h (gfc_resolve_random_seed): New prototype.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+

        PR fortran/32860
        * error.c (error_uinteger): New function.
        (error_integer): Call error_uinteger.
        PR fortran/32860
        * error.c (error_uinteger): New function.
        (error_integer): Call error_uinteger.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index f0de08f..23955de 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2880,8 +2880,15 @@ gfc_check_random_number (gfc_expr *harvest)
 try
 gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 {
 try
 gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 {

+  unsigned int nargs = 0;
+  locus *where = NULL;
+

   if (size != NULL)
     {
   if (size != NULL)
     {

+      if (size->expr_type != EXPR_VARIABLE
+         || !size->symtree->n.sym->attr.optional)
+       nargs++;
+

       if (scalar_check (size, 0) == FAILURE)
        return FAILURE;
 
       if (scalar_check (size, 0) == FAILURE)
        return FAILURE;
 


@@ -2897,10 +2904,12 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 
   if (put != NULL)
     {
 
   if (put != NULL)
     {

-
-      if (size != NULL)
-       gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic,
-                   &put->where);
+      if (put->expr_type != EXPR_VARIABLE
+         || !put->symtree->n.sym->attr.optional)
+       {
+         nargs++;
+         where = &put->where;
+       }

 
       if (array_check (put, 1) == FAILURE)
        return FAILURE;
 
       if (array_check (put, 1) == FAILURE)
        return FAILURE;


@@ -2917,10 +2926,12 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 
   if (get != NULL)
     {
 
   if (get != NULL)
     {

-
-      if (size != NULL || put != NULL)
-       gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic,
-                  &get->where);
+      if (get->expr_type != EXPR_VARIABLE
+         || !get->symtree->n.sym->attr.optional)
+       {
+         nargs++;
+         where = &get->where;
+       }

 
       if (array_check (get, 2) == FAILURE)
        return FAILURE;
 
       if (array_check (get, 2) == FAILURE)
        return FAILURE;


@@ -2938,6 +2949,10 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
        return FAILURE;
     }
 
        return FAILURE;
     }
 

+  /* RANDOM_SEED may not have more than one non-optional argument.  */
+  if (nargs > 1)
+    gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic, where);
+

   return SUCCESS;
 }
 
   return SUCCESS;
 }
 

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 59006b2..7f02245 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2467,8 +2467,9 @@ add_subroutines (void)
              gfc_check_random_number, NULL, gfc_resolve_random_number,
              h, BT_REAL, dr, REQUIRED);
 
              gfc_check_random_number, NULL, gfc_resolve_random_number,
              h, BT_REAL, dr, REQUIRED);
 

-  add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
-             gfc_check_random_seed, NULL, NULL,
+  add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
+             BT_UNKNOWN, 0, GFC_STD_F95,
+             gfc_check_random_seed, NULL, gfc_resolve_random_seed,

              sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
              gt, BT_INTEGER, di, OPTIONAL);
 
              sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
              gt, BT_INTEGER, di, OPTIONAL);
 

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 79cf3e5..1e03e0c 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -487,6 +487,7 @@ void gfc_resolve_ltime (gfc_code *);
 void gfc_resolve_mvbits (gfc_code *);
 void gfc_resolve_perror (gfc_code *);
 void gfc_resolve_random_number (gfc_code *);
 void gfc_resolve_mvbits (gfc_code *);
 void gfc_resolve_perror (gfc_code *);
 void gfc_resolve_random_number (gfc_code *);

+void gfc_resolve_random_seed (gfc_code *);

 void gfc_resolve_rename_sub (gfc_code *);
 void gfc_resolve_link_sub (gfc_code *);
 void gfc_resolve_symlnk_sub (gfc_code *);
 void gfc_resolve_rename_sub (gfc_code *);
 void gfc_resolve_link_sub (gfc_code *);
 void gfc_resolve_symlnk_sub (gfc_code *);

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index e318615..6232374 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2507,6 +2507,16 @@ gfc_resolve_random_number (gfc_code *c)
 
 
 void
 
 
 void

+gfc_resolve_random_seed (gfc_code *c)
+{
+  const char *name;
+
+  name = gfc_get_string (PREFIX ("random_seed_i%d"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void

 gfc_resolve_rename_sub (gfc_code *c)
 {
   const char *name;
 gfc_resolve_rename_sub (gfc_code *c)
 {
   const char *name;

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1ae601f..d421a73 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2303,36 +2303,38 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
            } 
        }
 
            } 
        }
 

-      if (fsym)
+      /* The case with fsym->attr.optional is that of a user subroutine
+        with an interface indicating an optional argument.  When we call
+        an intrinsic subroutine, however, fsym is NULL, but we might still
+        have an optional argument, so we proceed to the substitution
+        just in case.  */
+      if (e && (fsym == NULL || fsym->attr.optional))

        {
        {

-         if (e)
+         /* If an optional argument is itself an optional dummy argument,
+            check its presence and substitute a null if absent.  */
+         if (e->expr_type == EXPR_VARIABLE
+             && e->symtree->n.sym->attr.optional)
+           gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts);
+       }
+
+      if (fsym && e)
+       {
+         /* Obtain the character length of an assumed character length
+            length procedure from the typespec.  */
+         if (fsym->ts.type == BT_CHARACTER
+             && parmse.string_length == NULL_TREE
+             && e->ts.type == BT_PROCEDURE
+             && e->symtree->n.sym->ts.type == BT_CHARACTER
+             && e->symtree->n.sym->ts.cl->length != NULL)

            {
            {

-             /* If an optional argument is itself an optional dummy
-                argument, check its presence and substitute a null
-                if absent.  */
-             if (e->expr_type == EXPR_VARIABLE
-                   && e->symtree->n.sym->attr.optional
-                   && fsym->attr.optional)
-               gfc_conv_missing_dummy (&parmse, e, fsym->ts);
-
-             /* Obtain the character length of an assumed character
-                length procedure from the typespec.  */
-             if (fsym->ts.type == BT_CHARACTER
-                   && parmse.string_length == NULL_TREE
-                   && e->ts.type == BT_PROCEDURE
-                   && e->symtree->n.sym->ts.type == BT_CHARACTER
-                   && e->symtree->n.sym->ts.cl->length != NULL)
-               {
-                 gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
-                 parmse.string_length
-                       = e->symtree->n.sym->ts.cl->backend_decl;
-               }
+             gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
+             parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;

            }
            }

-
-         if (need_interface_mapping)
-           gfc_add_interface_mapping (&mapping, fsym, &parmse);

        }
 
        }
 

+      if (fsym && need_interface_mapping)
+       gfc_add_interface_mapping (&mapping, fsym, &parmse);
+

       gfc_add_block_to_block (&se->pre, &parmse.pre);
       gfc_add_block_to_block (&post, &parmse.post);
 
       gfc_add_block_to_block (&se->pre, &parmse.pre);
       gfc_add_block_to_block (&post, &parmse.post);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 106fe59..6640aee 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,14 @@
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 

+       PR fortran/30964
+       PR fortran/33054
+       * gfortran.dg/random_4.f90: New test.
+       * gfortran.dg/random_5.f90: New test.
+       * gfortran.dg/random_6.f90: New test.
+       * gfortran.dg/random_7.f90: New test.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+

        PR fortran/32860
        * gcc.dg/format/gcc_gfc-1.c: Updated with new formats.
 
        PR fortran/32860
        * gcc.dg/format/gcc_gfc-1.c: Updated with new formats.
 

diff --git a/gcc/testsuite/gfortran.dg/random_4.f90 b/gcc/testsuite/gfortran.dg/random_4.f90
new file mode 100644 (file)
index 0000000..416b17c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_4.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+program trs
+  implicit none
+  integer :: size, ierr
+  integer, allocatable, dimension(:) :: seed, check
+  call test_random_seed(size)
+  allocate(seed(size),check(size))
+  call test_random_seed(put=seed)
+  call test_random_seed(get=check)
+  if (any (seed /= check)) call abort
+contains
+  subroutine test_random_seed(size, put, get)
+    integer, optional :: size
+    integer, dimension(:), optional :: put
+    integer, dimension(:), optional :: get
+    call random_seed(size, put, get)
+  end subroutine test_random_seed
+end program trs

diff --git a/gcc/testsuite/gfortran.dg/random_5.f90 b/gcc/testsuite/gfortran.dg/random_5.f90
new file mode 100644 (file)
index 0000000..418bd68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_5.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-shouldfail "" }
+!
+program trs
+  implicit none
+  integer :: size
+  integer :: seed(50)
+  call test_random_seed(size,seed)
+contains
+  subroutine test_random_seed(size, put, get)
+    integer, optional :: size
+    integer, dimension(:), optional :: put
+    integer, dimension(:), optional :: get
+    call random_seed(size, put, get)
+  end subroutine test_random_seed
+end program trs
+! { dg-output "Fortran runtime error: RANDOM_SEED should have at most one argument present.*" }

diff --git a/gcc/testsuite/gfortran.dg/random_6.f90 b/gcc/testsuite/gfortran.dg/random_6.f90
new file mode 100644 (file)
index 0000000..078c8af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_6.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+subroutine test1 (size, put, get)
+  integer :: size
+  integer, dimension(:), optional :: put
+  integer, dimension(:), optional :: get
+  call random_seed(size, put, get)
+end
+
+subroutine test2 (size, put, get)
+  integer, optional :: size
+  integer, dimension(:) :: put
+  integer, dimension(:) :: get
+  call random_seed(size, put, get) ! { dg-error "Too many arguments" }
+end

diff --git a/gcc/testsuite/gfortran.dg/random_7.f90 b/gcc/testsuite/gfortran.dg/random_7.f90
new file mode 100644 (file)
index 0000000..46d8ccb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_7.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+!
+program trs
+  implicit none
+  integer :: size, ierr
+  integer, allocatable, dimension(:) :: seed, check
+  call test_random_seed(size)
+  allocate(seed(size),check(size))
+  call test_random_seed(put=seed)
+  call test_random_seed(get=check)
+  if (any (seed /= check)) call abort
+contains
+  subroutine test_random_seed(size, put, get)
+    integer, optional :: size
+    integer, dimension(:), optional :: put
+    integer, dimension(:), optional :: get
+    call random_seed(size, put, get)
+  end subroutine test_random_seed
+end program trs

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 13c6f28..1d4055b 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,15 @@
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/30964
+       PR fortran/33054
+       * intrinsics/random.c (random_seed): Rename into random_seed_i4.
+       (random_seed_i8): New function.
+       * gfortran.map (GFORTRAN_1.0): Remove _gfortran_random_seed,
+       add _gfortran_random_seed_i4 and _gfortran_random_seed_i8.
+       * libgfortran.h (iexport_proto): Replace random_seed by
+       random_seed_i4 and random_seed_i8.
+       * runtime/main.c (init): Call the new random_seed_i4.
+

 2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
            Tobias Burnus  <burnus@gcc.gnu.org>
 
 2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
            Tobias Burnus  <burnus@gcc.gnu.org>
 

diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 8cfc236..31ca41e 100644 (file)
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -553,7 +553,8 @@ GFORTRAN_1.0 {
     _gfortran_random_r16;
     _gfortran_random_r4;
     _gfortran_random_r8;
     _gfortran_random_r16;
     _gfortran_random_r4;
     _gfortran_random_r8;

-    _gfortran_random_seed;
+    _gfortran_random_seed_i4;
+    _gfortran_random_seed_i8;

     _gfortran_rename_i4;
     _gfortran_rename_i4_sub;
     _gfortran_rename_i8;
     _gfortran_rename_i4;
     _gfortran_rename_i4_sub;
     _gfortran_rename_i8;

diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index 9a31a0e..f64f21c 100644 (file)
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -1,5 +1,5 @@
 /* Implementation of the RANDOM intrinsics
 /* Implementation of the RANDOM intrinsics

-   Copyright 2002, 2004, 2005, 2006 Free Software Foundation, Inc.
+   Copyright 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.

    Contributed by Lars Segerlund <seger@linuxmail.org>
    and Steve Kargl.
 
    Contributed by Lars Segerlund <seger@linuxmail.org>
    and Steve Kargl.
 


@@ -32,6 +32,7 @@ Boston, MA 02110-1301, USA.  */
 #include "config.h"
 #include "libgfortran.h"
 #include <gthr.h>
 #include "config.h"
 #include "libgfortran.h"
 #include <gthr.h>

+#include <string.h>

 
 extern void random_r4 (GFC_REAL_4 *);
 iexport_proto(random_r4);
 
 extern void random_r4 (GFC_REAL_4 *);
 iexport_proto(random_r4);


@@ -644,22 +645,22 @@ arandom_r16 (gfc_array_r16 *x)
    must be called with no argument or exactly one argument.  */
 
 void
    must be called with no argument or exactly one argument.  */
 
 void

-random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
+random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)

 {
   int i;
 
   __gthread_mutex_lock (&random_lock);
 
 {
   int i;
 
   __gthread_mutex_lock (&random_lock);
 

-  if (size == NULL && put == NULL && get == NULL)
-    {
-      /* From the standard: "If no argument is present, the processor assigns
-         a processor-dependent value to the seed."  */
+  /* Check that we only have one argument present.  */
+  if ((size ? 1 : 0) + (put ? 1 : 0) + (get ? 1 : 0) > 1)
+    runtime_error ("RANDOM_SEED should have at most one argument present.");

 
 

-      for (i=0; i<kiss_size; i++)
+  /* From the standard: "If no argument is present, the processor assigns
+     a processor-dependent value to the seed."  */
+  if (size == NULL && put == NULL && get == NULL)
+      for (i = 0; i < kiss_size; i++)

        kiss_seed[i] = kiss_default_seed[i];
 
        kiss_seed[i] = kiss_default_seed[i];
 

-    }
-

   if (size != NULL)
     *size = kiss_size;
 
   if (size != NULL)
     *size = kiss_size;
 


@@ -675,7 +676,7 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
 
       /*  This code now should do correct strides.  */
       for (i = 0; i < kiss_size; i++)
 
       /*  This code now should do correct strides.  */
       for (i = 0; i < kiss_size; i++)

-       kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
+       kiss_seed[i] = (GFC_UINTEGER_4) put->data[i * put->dim[0].stride];

     }
 
   /* Return the seed to GET data.  */
     }
 
   /* Return the seed to GET data.  */


@@ -696,7 +697,65 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
 
   __gthread_mutex_unlock (&random_lock);
 }
 
   __gthread_mutex_unlock (&random_lock);
 }

-iexport(random_seed);
+iexport(random_seed_i4);
+
+
+void
+random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
+{
+  int i;
+
+  __gthread_mutex_lock (&random_lock);
+
+  /* Check that we only have one argument present.  */
+  if ((size ? 1 : 0) + (put ? 1 : 0) + (get ? 1 : 0) > 1)
+    runtime_error ("RANDOM_SEED should have at most one argument present.");
+
+  /* From the standard: "If no argument is present, the processor assigns
+     a processor-dependent value to the seed."  */
+  if (size == NULL && put == NULL && get == NULL)
+      for (i = 0; i < kiss_size; i++)
+       kiss_seed[i] = kiss_default_seed[i];
+
+  if (size != NULL)
+    *size = kiss_size / 2;
+
+  if (put != NULL)
+    {
+      /* If the rank of the array is not 1, abort.  */
+      if (GFC_DESCRIPTOR_RANK (put) != 1)
+        runtime_error ("Array rank of PUT is not 1.");
+
+      /* If the array is too small, abort.  */
+      if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size / 2)
+        runtime_error ("Array size of PUT is too small.");
+
+      /*  This code now should do correct strides.  */
+      for (i = 0; i < kiss_size; i += 2)
+       memcpy (&kiss_seed[i], &(put->data[i * put->dim[0].stride]),
+               sizeof (GFC_UINTEGER_8));
+    }
+
+  /* Return the seed to GET data.  */
+  if (get != NULL)
+    {
+      /* If the rank of the array is not 1, abort.  */
+      if (GFC_DESCRIPTOR_RANK (get) != 1)
+       runtime_error ("Array rank of GET is not 1.");
+
+      /* If the array is too small, abort.  */
+      if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size / 2)
+       runtime_error ("Array size of GET is too small.");
+
+      /*  This code now should do correct strides.  */
+      for (i = 0; i < kiss_size; i += 2)
+       memcpy (&(get->data[i * get->dim[0].stride]), &kiss_seed[i],
+               sizeof (GFC_UINTEGER_8));
+    }
+
+  __gthread_mutex_unlock (&random_lock);
+}
+iexport(random_seed_i8);

 
 
 #ifndef __GTHREAD_MUTEX_INIT
 
 
 #ifndef __GTHREAD_MUTEX_INIT

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 0671801..ce6d28e 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -768,9 +768,12 @@ iexport_proto(compare_string);
 
 /* random.c */
 
 
 /* random.c */
 

-extern void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
-                        gfc_array_i4 * get);
-iexport_proto(random_seed);
+extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
+                           gfc_array_i4 * get);
+iexport_proto(random_seed_i4);
+extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
+                           gfc_array_i8 * get);
+iexport_proto(random_seed_i8);

 
 /* size.c */
 
 
 /* size.c */
 

diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index 570e959..87adcd2 100644 (file)
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -162,7 +162,7 @@ init (void)
   /* if (argc > 1 && strcmp(argv[1], "--resume") == 0) resume();  */
 #endif
 
   /* if (argc > 1 && strcmp(argv[1], "--resume") == 0) resume();  */
 #endif
 

-  random_seed(NULL,NULL,NULL);
+  random_seed_i4 (NULL, NULL, NULL);

 }
 
 
 }