From 42be2202fc2ad802bc61e29eac492a13493c5bce Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 18 Apr 2011 17:21:24 +0000 Subject: [PATCH] 2011-04-18 Tobias Burnus 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 PR fortran/18918 * gfortran.dg/coarray_17.f90: New. * gfortran.dg/coarray_10.f90: Update dg-error. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@172658 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/array.c | 6 ++++++ gcc/fortran/check.c | 17 +++++++++++++++++ gcc/fortran/simplify.c | 15 ++------------- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/coarray_10.f90 | 4 ++-- gcc/testsuite/gfortran.dg/coarray_17.f90 | 21 +++++++++++++++++++++ 7 files changed, 62 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_17.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7154e621211..a55e1c0d3d2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,6 +1,14 @@ 2011-04-18 Tobias Burnus 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 + + PR fortran/18918 * iresolve.c (gfc_resolve_image_index): Set ts.type. * simplify.c (gfc_simplify_image_index): Don't abort if the bounds are not known at compile time and handle -fcoarray=lib. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index ff0977a5dfe..750d73315f2 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -237,6 +237,12 @@ coarray: corank, ar->codimen); return MATCH_ERROR; } + if (ar->codimen > corank) + { + gfc_error ("Too many codimensions at %C, expected %d not %d", + corank, ar->codimen); + return MATCH_ERROR; + } return MATCH_YES; } diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index bb56122137e..86411420673 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; } diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index b744a214ed5..784f27fc793 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -6211,12 +6211,7 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub) gfc_expr *ca_bound; int cmp; - if (sub_cons == NULL) - { - gfc_error ("Too few elements in expression for SUB= argument at %L", - &sub->where); - return &gfc_bad_expr; - } + gcc_assert (sub_cons != NULL); ca_bound = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true); @@ -6278,13 +6273,7 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub) sub_cons = gfc_constructor_next (sub_cons); } - if (sub_cons != NULL) - { - gfc_error ("Too many elements in expression for SUB= argument at %L", - &sub->where); - return &gfc_bad_expr; - } - + gcc_assert (sub_cons == NULL); if (gfc_option.coarray != GFC_FCOARRAY_SINGLE && !first_image) return NULL; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7014a0cdbc0..58bf81ac2a8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-04-18 Tobias Burnus + + PR fortran/18918 + * gfortran.dg/coarray_17.f90: New. + * gfortran.dg/coarray_10.f90: Update dg-error. + 2011-04-18 Rainer Orth PR testsuite/48251 diff --git a/gcc/testsuite/gfortran.dg/coarray_10.f90 b/gcc/testsuite/gfortran.dg/coarray_10.f90 index d32e25478c7..99f5782e35b 100644 --- a/gcc/testsuite/gfortran.dg/coarray_10.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_10.f90 @@ -11,8 +11,8 @@ subroutine image_idx_test1() WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1]) WRITE (*,*) IMAGE_INDEX (array, [0,0,3,1]) ! { dg-error "for dimension 1, SUB has 0 and COARRAY lower bound is 1" } WRITE (*,*) IMAGE_INDEX (array, [1,2,9,0]) ! { dg-error "for dimension 3, SUB has 9 and COARRAY upper bound is 8" } - WRITE (*,*) IMAGE_INDEX (array, [2,0,3]) ! { dg-error "Too few elements" } - WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1,1])! { dg-error "Too many elements" } + WRITE (*,*) IMAGE_INDEX (array, [2,0,3]) ! { dg-error "array elements of the SUB argument to IMAGE_INDEX at .1. shall be 4" } + WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1,1])! { dg-error "array elements of the SUB argument to IMAGE_INDEX at .1. shall be 4" } end subroutine subroutine this_image_check() diff --git a/gcc/testsuite/gfortran.dg/coarray_17.f90 b/gcc/testsuite/gfortran.dg/coarray_17.f90 new file mode 100644 index 00000000000..ad6da29f1a3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_17.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! Two simple diagnostics, which were initially not thought of +! +! General coarray PR: PR fortran/18918 +! + +subroutine one + integer, allocatable :: a(:)[:,:] ! corank = 2 + integer :: index,nn1,nn2,nn3,mm0 + + allocate(a(mm0)[nn1:nn2,nn3,*]) ! { dg-error "Too many codimensions at .1., expected 2 not 3" } +end subroutine one + +subroutine two + integer, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:)[:] + index1 = image_index(a, [2, 1, 1] ) !OK + index2 = image_index(b, [2, 1, 1] ) ! { dg-error "array elements of the SUB argument to IMAGE_INDEX at .1. shall be 2 .corank. not 3" } + index3 = image_index(c, [1] ) !OK +end subroutine two -- 2.11.4.GIT