Re: [Patch, fortran] PR37159

["Dennis Wassel" <dennis dot wassel at googlemail dot com>]

2008/8/24 Dennis Wassel <dennis.wassel@googlemail.com>:
> Heej list,
>
> here my first ever attempt at submitting a patch!
> I'll start an overnight bootstrap and regression test on GNU
> x86-32(-virtualbox)-linux and until then -well- look forward to some
> tutoring :-)
>
> Cheers,
> Dennis
>

Ok, here is my reworked patch, this time also posted to gcc-patches.
I have worked on coding style (taking the liberty to adapt some
existing comments in check.c) and replaced the HAVE_GFC_REAL_16 by
gfc_validate_kind() in check.c, as Tobias suggested.

Currently regression-testing on my x86-32-linux. Takes >1h (big >) on
my Virtualbox - is this normal or just virtualisation slowing things
down?
As Thomas Koenig suggested, this should also be tested on a system
which has REAL(16), but I don't have access to one, and using the
compile farm doesn't look trivial enough to just give it a spin -
could someone with such a system do me that favour? Thanks a lot!
Speaking of testing: I still have not come up with a solution to
telling systems with REAL(10) and (16) apart in the testsuite. Further
ideas?

I cannot convince my mailer to attach the f90-file as MIME-type text -
should I use a "rename trick" (i.e. add .txt suffix) or is this fine
with everybody?

And lastly: Is this the proper way to do the Changelog?

gcc/Changelog:
2008-09-09  Dennis Wassel  <dennis.wassel@googlemail.com>
	PR fortran/37159
	* fortran/check.c (gfc_check_random_seed): Check size of PUT array at
compile time.

libgfortran/Changelog:
2008-09-09  Dennis Wassel  <dennis.wassel@googlemail.com>
	PR fortran/37159
	* intrinsics/random.c: Added comment to adapt check.c, should kiss_size change.
	Few cosmetic changes to existing comments.

testsuite/Changelog:
2008-09-09  Dennis Wassel  <dennis.wassel@googlemail.com>
	PR fortran/37159
	* gfortran.dg/random_seed_1.f90: New testcase.

-- Dennis

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(Revision 140117)
+++ gcc/fortran/check.c	(Arbeitskopie)
@@ -3120,9 +3120,16 @@ gfc_check_random_number (gfc_expr *harve
 gfc_try
 gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 {
-  unsigned int nargs = 0;
+  unsigned int nargs = 0, kiss_size;
   locus *where = NULL;
+  mpz_t put_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;
+  
   if (size != NULL)
     {
       if (size->expr_type != EXPR_VARIABLE
@@ -3162,6 +3169,12 @@ gfc_check_random_seed (gfc_expr *size, g
 
       if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE)
 	return FAILURE;
+
+      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);
     }
 
   if (get != NULL)
Index: libgfortran/intrinsics/random.c
===================================================================
--- libgfortran/intrinsics/random.c	(Revision 140117)
+++ libgfortran/intrinsics/random.c	(Arbeitskopie)
@@ -75,8 +75,7 @@ static __gthread_mutex_t random_lock;
    GFC_REAL_* types in the range of [0,1).  If GFC_REAL_*_RADIX are 2
    or 16, respectively, we mask off the bits that don't fit into the
    correct GFC_REAL_*, convert to the real type, then multiply by the
-   correct offset.
-*/
+   correct offset.  */
 
 
 static inline void
@@ -214,8 +213,7 @@ KISS algorithm.  */
    We do this by using three generators with different seeds, the
    first one always for the most significant bits, the second one
    for bits 33..64 (if present in the REAL kind), and the third one
-   (called twice) for REAL(16).
-*/
+   (called twice) for REAL(16).  */
 
 #define GFC_SL(k, n)	((k)^((k)<<(n)))
 #define GFC_SR(k, n)	((k)^((k)>>(n)))
@@ -229,8 +227,11 @@ KISS algorithm.  */
    with 0<=x<2^32, 0<y<2^32, 0<=z<2^32, 0<=c<698769069
    except that the two pairs
    z=0,c=0 and z=2^32-1,c=698769068
-   should be avoided.
-*/
+   should be avoided.  */
+
+/* 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.  */
 
 #define KISS_DEFAULT_SEED_1 123456789, 362436069, 521288629, 316191069
 #define KISS_DEFAULT_SEED_2 987654321, 458629013, 582859209, 438195021
@@ -390,7 +391,7 @@ arandom_r4 (gfc_array_r4 *x)
 
   while (dest)
     {
-      /* random_r4 (dest); */
+      /* random_r4 (dest);  */
       kiss = kiss_random_kernel (kiss_seed_1);
       rnumber_4 (dest, kiss);
 
@@ -457,7 +458,7 @@ arandom_r8 (gfc_array_r8 *x)
 
   while (dest)
     {
-      /* random_r8 (dest); */
+      /* random_r8 (dest);  */
       kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
       kiss += kiss_random_kernel (kiss_seed_2);
       rnumber_8 (dest, kiss);
@@ -527,7 +528,7 @@ arandom_r10 (gfc_array_r10 *x)
 
   while (dest)
     {
-      /* random_r10 (dest); */
+      /* random_r10 (dest);  */
       kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
       kiss += kiss_random_kernel (kiss_seed_2);
       rnumber_10 (dest, kiss);
@@ -599,7 +600,7 @@ arandom_r16 (gfc_array_r16 *x)
 
   while (dest)
     {
-      /* random_r16 (dest); */
+      /* random_r16 (dest);  */
       kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
       kiss1 += kiss_random_kernel (kiss_seed_2);

Attachment: random_seed_1.f90
Description: Binary data