PR 60324 VLA related fixes to random number generator.

2014-11-16  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/60324
	* intrinsics/random.c (kiss_size): Rename to KISS_SIZE, make it a
	macro instead of a variable.
	(random_seed_i4): Make seed correct size, remove assert, KISS_SIZE
	related changes.
	(random_seed_i8): KISS_SIZE related changes.

From-SVN: r217623

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index b941e734673a57ebf768319fcca596540d277689..a389a4231b5850e61f177e14d1b794c17832e47d 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2014-11-16  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR libfortran/60324
+       * intrinsics/random.c (kiss_size): Rename to KISS_SIZE, make it a
+       macro instead of a variable.
+       (random_seed_i4): Make seed correct size, remove assert, KISS_SIZE
+       related changes.
+       (random_seed_i8): KISS_SIZE related changes.
+
 2014-11-13  Marek Polacek  <polacek@redhat.com>
 
        * intrinsics/access.c: Include <stdlib.h>.

diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index 5e919292aabc4ccee44f0559909b9ff5e56e36fb..d2510b2ad145748c513054f92c1497ea4179de0b 100644 (file)
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -224,7 +224,7 @@ KISS algorithm.  */
    z=0,c=0 and z=2^32-1,c=698769068
    should be avoided.  */
 
-/* Any modifications to the seeds that change kiss_size below need to be
+/* Any modifications to the seeds that change KISS_SIZE below need to be
    reflected in check.c (gfc_check_random_seed) to enable correct
    compile-time checking of PUT size for the RANDOM_SEED intrinsic.  */
 
@@ -250,7 +250,7 @@ static GFC_UINTEGER_4 kiss_default_seed[] = {
 #endif
 };
 
-static const GFC_INTEGER_4 kiss_size = sizeof(kiss_seed)/sizeof(kiss_seed[0]);
+#define KISS_SIZE (sizeof(kiss_seed)/sizeof(kiss_seed[0]))
 
 static GFC_UINTEGER_4 * const kiss_seed_1 = kiss_seed;
 static GFC_UINTEGER_4 * const kiss_seed_2 = kiss_seed + 4;
@@ -665,12 +665,7 @@ unscramble_seed (unsigned char *dest, unsigned char *src, int size)
 void
 random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
 {
-  int i;
-
-#define KISS_MAX_SIZE 12
-  unsigned char seed[4 * KISS_MAX_SIZE];
-  _Static_assert (kiss_size <= KISS_MAX_SIZE,
-                 "kiss_size must <= KISS_MAX_SIZE");
+  unsigned char seed[4 * KISS_SIZE];
 
   __gthread_mutex_lock (&random_lock);
 
@@ -681,11 +676,11 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
   /* 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++)
+      for (size_t i = 0; i < KISS_SIZE; i++)
        kiss_seed[i] = kiss_default_seed[i];
 
   if (size != NULL)
-    *size = kiss_size;
+    *size = KISS_SIZE;
 
   if (put != NULL)
     {
@@ -694,18 +689,18 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
         runtime_error ("Array rank of PUT is not 1.");
 
       /* If the array is too small, abort.  */
-      if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size)
+      if (GFC_DESCRIPTOR_EXTENT(put,0) < (index_type) KISS_SIZE)
         runtime_error ("Array size of PUT is too small.");
 
       /*  We copy the seed given by the user.  */
-      for (i = 0; i < kiss_size; i++)
+      for (size_t i = 0; i < KISS_SIZE; i++)
        memcpy (seed + i * sizeof(GFC_UINTEGER_4),
-               &(put->base_addr[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(put,0)]),
+               &(put->base_addr[(KISS_SIZE - 1 - i) * GFC_DESCRIPTOR_STRIDE(put,0)]),
                sizeof(GFC_UINTEGER_4));
 
       /* We put it after scrambling the bytes, to paper around users who
         provide seeds with quality only in the lower or upper part.  */
-      scramble_seed ((unsigned char *) kiss_seed, seed, 4*kiss_size);
+      scramble_seed ((unsigned char *) kiss_seed, seed, 4 * KISS_SIZE);
     }
 
   /* Return the seed to GET data.  */
@@ -716,15 +711,15 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
        runtime_error ("Array rank of GET is not 1.");
 
       /* If the array is too small, abort.  */
-      if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size)
+      if (GFC_DESCRIPTOR_EXTENT(get,0) < (index_type) KISS_SIZE)
        runtime_error ("Array size of GET is too small.");
 
       /* Unscramble the seed.  */
-      unscramble_seed (seed, (unsigned char *) kiss_seed, 4*kiss_size);
+      unscramble_seed (seed, (unsigned char *) kiss_seed, 4 * KISS_SIZE);
 
       /*  Then copy it back to the user variable.  */
-      for (i = 0; i < kiss_size; i++)
-       memcpy (&(get->base_addr[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(get,0)]),
+      for (size_t i = 0; i < KISS_SIZE; i++)
+       memcpy (&(get->base_addr[(KISS_SIZE - 1 - i) * GFC_DESCRIPTOR_STRIDE(get,0)]),
                seed + i * sizeof(GFC_UINTEGER_4),
                sizeof(GFC_UINTEGER_4));
     }
@@ -737,8 +732,6 @@ 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.  */
@@ -748,11 +741,11 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
   /* 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++)
+      for (size_t i = 0; i < KISS_SIZE; i++)
        kiss_seed[i] = kiss_default_seed[i];
 
   if (size != NULL)
-    *size = kiss_size / 2;
+    *size = KISS_SIZE / 2;
 
   if (put != NULL)
     {
@@ -761,11 +754,11 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
         runtime_error ("Array rank of PUT is not 1.");
 
       /* If the array is too small, abort.  */
-      if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size / 2)
+      if (GFC_DESCRIPTOR_EXTENT(put,0) < (index_type) 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 / 2; i++)
+      for (size_t i = 0; i < KISS_SIZE / 2; i++)
        memcpy (&kiss_seed[2*i], &(put->base_addr[i * GFC_DESCRIPTOR_STRIDE(put,0)]),
                sizeof (GFC_UINTEGER_8));
     }
@@ -778,11 +771,11 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
        runtime_error ("Array rank of GET is not 1.");
 
       /* If the array is too small, abort.  */
-      if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size / 2)
+      if (GFC_DESCRIPTOR_EXTENT(get,0) < (index_type) 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 / 2; i++)
+      for (size_t i = 0; i < KISS_SIZE / 2; i++)
        memcpy (&(get->base_addr[i * GFC_DESCRIPTOR_STRIDE(get,0)]), &kiss_seed[2*i],
                sizeof (GFC_UINTEGER_8));
     }