diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-04-18 19:21:24 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-04-18 19:21:24 +0200 |
| commit | e84b920c7c572f009e90ab39bab51c715de99c84 (patch) | |
| tree | bf6b6c568e6f3d79086e78008f4e7cd747eee634 /gcc/fortran/check.c | |
| parent | 9c41356cd209d7f8fd8a7a548a291f08a383c768 (diff) | |
| download | gcc-e84b920c7c572f009e90ab39bab51c715de99c84.zip gcc-e84b920c7c572f009e90ab39bab51c715de99c84.tar.gz gcc-e84b920c7c572f009e90ab39bab51c715de99c84.tar.bz2 | |
re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
2011-04-18 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* array.c (gfc_match_array_ref): Check for too many
* codimensions.
* check.c (gfc_check_image_index): Check number of elements
in SUB argument.
* simplify.c (gfc_simplify_image_index): Remove unreachable
* checks.
2011-04-18 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_17.f90: New.
* gfortran.dg/coarray_10.f90: Update dg-error.
From-SVN: r172658
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index bb56122..8641142 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3667,6 +3667,8 @@ gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status) gfc_try gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub) { + mpz_t nelems; + if (gfc_option.coarray == GFC_FCOARRAY_NONE) { gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable"); @@ -3683,6 +3685,21 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub) return FAILURE; } + if (gfc_array_size (sub, &nelems) == SUCCESS) + { + int corank = gfc_get_corank (coarray); + + if (mpz_cmp_ui (nelems, corank) != 0) + { + gfc_error ("The number of array elements of the SUB argument to " + "IMAGE_INDEX at %L shall be %d (corank) not %d", + &sub->where, corank, (int) mpz_get_si (nelems)); + mpz_clear (nelems); + return FAILURE; + } + mpz_clear (nelems); + } + return SUCCESS; } |