From 1b867ae782244908713c24c26f526e65a35f6d12 Mon Sep 17 00:00:00 2001 From: Dennis Wassel Date: Sat, 1 Nov 2008 10:24:15 +0000 Subject: [PATCH] re PR fortran/37159 (RANDOM_SEED: GET= check array size at compile time and respect -fdefault-integer-*) 2008-11-01 Dennis Wassel PR fortran/37159 * fortran/check.c (gfc_check_random_seed): Check PUT size at compile time. 2008-11-01 Dennis Wassel PR fortran/37159 * intrinsics/random.c: Added comment to adapt check.c, should kiss_size change. Few cosmetic changes to existing comments. 2008-11-01 Dennis Wassel PR fortran/37159 * gfortran.dg/random_seed_1.f90: New testcase. From-SVN: r141511 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/check.c | 15 ++++++++++++++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/random_seed_1.f90 | 14 ++++++++++++++ libgfortran/ChangeLog | 7 +++++++ libgfortran/intrinsics/random.c | 21 +++++++++++---------- 6 files changed, 57 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/random_seed_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f7f763f9767..8f0e58d1548 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-11-01 Dennis Wassel + + PR fortran/37159 + * fortran/check.c (gfc_check_random_seed): Check PUT size + at compile time. + 2008-10-31 Mikael Morin PR fortran/35840 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 1f9ce2fff6a..de507676491 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3120,9 +3120,16 @@ gfc_check_random_number (gfc_expr *harvest) 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, gfc_expr *put, gfc_expr *get) 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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9051361982e..db83bac28e3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-11-01 Dennis Wassel + + PR fortran/37159 + * gfortran.dg/random_seed_1.f90: New testcase. + 2008-10-31 Manuel López-Ibáñez * gcc.dg/cpp/Wsignprom.c: Add column numbers. diff --git a/gcc/testsuite/gfortran.dg/random_seed_1.f90 b/gcc/testsuite/gfortran.dg/random_seed_1.f90 new file mode 100644 index 00000000000..510badf7d68 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_seed_1.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } + +! Emit a diagnostic for too small PUT array at compile time +! See PR fortran/37159 + +! Possible improvement: +! Provide a separate testcase for systems that support REAL(16), +! to test the minimum size of 12 (instead of 8). + +PROGRAM random_seed_1 + IMPLICIT NONE + INTEGER :: small(7) + CALL RANDOM_SEED(PUT=small) ! { dg-error "is too small" } +END PROGRAM random_seed_1 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index c4630a57f11..2903760cb8c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2008-11-01 Dennis Wassel + + PR fortran/37159 + * intrinsics/random.c: Added comment to adapt check.c, should + kiss_size change. + Few cosmetic changes to existing comments. + 2008-10-22 Jerry DeLisle PR libfortran/37707 diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index 360e6ec22ba..24ba1058e57 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -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