gcc/fortran:

2009-01-05  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/37159
        * check.c (gfc_check_random_seed): Added size check for GET
        dummy argument, reworded error messages to follow common pattern.

gcc/testsuite:
2009-01-05  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/37159
        * gfortran.dg/random_seed_1.f90: Updated.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6622a0..8252bd4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-01-05  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/37159
+       * check.c (gfc_check_random_seed): Added size check for GET
+       dummy argument, reworded error messages to follow common pattern.
+
 2009-01-05  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/38672

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 228ccb2..5b6a2eb 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3136,14 +3136,15 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 {
   unsigned int nargs = 0, kiss_size;
   locus *where = NULL;
-  mpz_t put_size;
+  mpz_t put_size, get_size;
   bool have_gfc_real_16; /* Try and mimic HAVE_GFC_REAL_16 in libgfortran.  */
 
   have_gfc_real_16 = gfc_validate_kind (BT_REAL, 16, true) != -1;
 
-  /* Keep these values in sync with kiss_size in libgfortran/random.c.  */
-  kiss_size = have_gfc_real_16 ? 12 : 8;
-  
+  /* Keep the number of bytes in sync with kiss_size in
+     libgfortran/intrinsics/random.c.  */
+  kiss_size = (have_gfc_real_16 ? 48 : 32) / gfc_default_integer_kind;
+
   if (size != NULL)
     {
       if (size->expr_type != EXPR_VARIABLE
@@ -3186,9 +3187,10 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 
       if (gfc_array_size (put, &put_size) == SUCCESS
          && mpz_get_ui (put_size) < kiss_size)
-       gfc_error ("Array PUT of intrinsic %s is too small (%i/%i) at %L", 
-                  gfc_current_intrinsic, (int) mpz_get_ui (put_size),
-                  kiss_size, where);
+       gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+                  "too small (%i/%i)",
+                  gfc_current_intrinsic_arg[1], gfc_current_intrinsic, where, 
+                  (int) mpz_get_ui (put_size), kiss_size);
     }
 
   if (get != NULL)
@@ -3214,6 +3216,13 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 
       if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE)
        return FAILURE;
+
+       if (gfc_array_size (get, &get_size) == SUCCESS
+         && mpz_get_ui (get_size) < kiss_size)
+       gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+                  "too small (%i/%i)",
+                  gfc_current_intrinsic_arg[2], gfc_current_intrinsic, where, 
+                  (int) mpz_get_ui (get_size), kiss_size);
     }
 
   /* RANDOM_SEED may not have more than one non-optional argument.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0d2c47c..fbb3529 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-01-05  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/37159
+       * gfortran.dg/random_seed_1.f90: Updated.
+
 2009-01-05  Mikael Morin  <mikael.morin@tele2.fr>
 
        PR fortran/38669

diff --git a/gcc/testsuite/gfortran.dg/random_seed_1.f90 b/gcc/testsuite/gfortran.dg/random_seed_1.f90
index 510badf..45627ff 100644 (file)
--- a/gcc/testsuite/gfortran.dg/random_seed_1.f90
+++ b/gcc/testsuite/gfortran.dg/random_seed_1.f90
@@ -6,9 +6,35 @@
 ! Possible improvement:
 ! Provide a separate testcase for systems that support REAL(16),
 ! to test the minimum size of 12 (instead of 8).
+!
+! Updated to check for arrays of unexpected size,
+! this also works for -fdefault-integer-8.
+!
 
 PROGRAM random_seed_1
   IMPLICIT NONE
-  INTEGER :: small(7)
-  CALL RANDOM_SEED(PUT=small)   ! { dg-error "is too small" }
+  INTEGER, PARAMETER :: k = selected_real_kind (precision (0.0_8) + 1)
+  INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k == 16)
+
+  ! '+1' to avoid out-of-bounds warnings
+  INTEGER, PARAMETER    :: n = nbytes / KIND(n) + 1
+  INTEGER, DIMENSION(n) :: seed
+
+  ! Get seed, array too small
+  CALL RANDOM_SEED(GET=seed(1:(n-2)))  ! { dg-error "too small" }
+
+  ! Get seed, array bigger than necessary
+  CALL RANDOM_SEED(GET=seed(1:n))
+
+  ! Get seed, proper size
+  CALL RANDOM_SEED(GET=seed(1:(n-1)))
+
+  ! Put too few bytes
+  CALL RANDOM_SEED(PUT=seed(1:(n-2)))  ! { dg-error "too small" }
+
+  ! Put too many bytes
+  CALL RANDOM_SEED(PUT=seed(1:n))
+
+  ! Put the right amount of bytes
+  CALL RANDOM_SEED(PUT=seed(1:(n-1)))
 END PROGRAM random_seed_1