diff options
| author | dfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-01-05 19:34:02 +0000 |
|---|---|---|
| committer | dfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-01-05 19:34:02 +0000 |
| commit | 2daf21fd2ac89ab7de1439a0c27e5af2df119146 (patch) | |
| tree | 1d1722549d8cbb51b27aa4567e09ce0373c1253a /gcc/fortran/check.c | |
| parent | b8138586d1f45551fb6a72afe41a4b8999e05c4e (diff) | |
| download | gcc-2daf21fd2ac89ab7de1439a0c27e5af2df119146.tar.gz | |
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
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 228ccb2ef0f..5b6a2ebc302 100644 --- 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. */ |