From: Erik Edelmann Date: Mon, 6 Nov 2006 22:18:54 +0000 (+0000) Subject: re PR fortran/29630 ("Unclassifiable statement" with vector subscripts in initialization) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=abe601c7cbf05d1dbd2c92973e65ab5690c2ddca;p=gcc.git re PR fortran/29630 ("Unclassifiable statement" with vector subscripts in initialization) fortran/ 2006-11-06 Erik Edelmann PR fortran/29630 PR fortran/29679 * expr.c (find_array_section): Support vector subscripts. Don't add sizes for dimen_type == DIMEN_ELEMENT to the shape array. testsuite/ 2006-11-06 Erik Edelmann PR fortran/29630 PR fortran/29679 * gfortran.dg/initialization_2.f90: Test PRs 29630 and 29679 too. * gfortran.dg/initialization_3.f90: New. From-SVN: r118528 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7947f4a65d4..b8a628bbb19 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2006-11-06 Erik Edelmann + + PR fortran/29630 + PR fortran/29679 + * expr.c (find_array_section): Support vector subscripts. Don't + add sizes for dimen_type == DIMEN_ELEMENT to the shape array. + 2006-11-05 Bernhard Fischer PR fortran/21061 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 486da131d89..9c25e5aab24 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1013,7 +1013,9 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) int idx; int rank; int d; + int shape_i; long unsigned one = 1; + bool incr_ctr; mpz_t start[GFC_MAX_DIMENSIONS]; mpz_t end[GFC_MAX_DIMENSIONS]; mpz_t stride[GFC_MAX_DIMENSIONS]; @@ -1023,7 +1025,6 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) mpz_t tmp_mpz; mpz_t nelts; mpz_t ptr; - mpz_t stop; mpz_t index; gfc_constructor *cons; gfc_constructor *base; @@ -1032,6 +1033,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) gfc_expr *step; gfc_expr *upper; gfc_expr *lower; + gfc_constructor *vecsub[GFC_MAX_DIMENSIONS], *c; try t; t = SUCCESS; @@ -1057,9 +1059,11 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) mpz_init (end[d]); mpz_init (ctr[d]); mpz_init (stride[d]); + vecsub[d] = NULL; } /* Build the counters to clock through the array reference. */ + shape_i = 0; for (d = 0; d < rank; d++) { /* Make this stretch of code easier on the eye! */ @@ -1069,64 +1073,95 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) lower = ref->u.ar.as->lower[d]; upper = ref->u.ar.as->upper[d]; - if ((begin && begin->expr_type != EXPR_CONSTANT) - || (finish && finish->expr_type != EXPR_CONSTANT) - || (step && step->expr_type != EXPR_CONSTANT)) - { - t = FAILURE; - goto cleanup; - } - - /* Obtain the stride. */ - if (step) - mpz_set (stride[d], step->value.integer); + if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */ + { + gcc_assert(begin); + gcc_assert(begin->expr_type == EXPR_ARRAY); + gcc_assert(begin->rank == 1); + gcc_assert(begin->shape); + + vecsub[d] = begin->value.constructor; + mpz_set (ctr[d], vecsub[d]->expr->value.integer); + mpz_mul (nelts, nelts, begin->shape[0]); + mpz_set (expr->shape[shape_i++], begin->shape[0]); + + /* Check bounds. */ + for (c = vecsub[d]; c; c = c->next) + { + if (mpz_cmp (c->expr->value.integer, upper->value.integer) > 0 + || mpz_cmp (c->expr->value.integer, lower->value.integer) < 0) + { + gfc_error ("index in dimension %d is out of bounds " + "at %L", d + 1, &ref->u.ar.c_where[d]); + t = FAILURE; + goto cleanup; + } + } + } else - mpz_set_ui (stride[d], one); + { + if ((begin && begin->expr_type != EXPR_CONSTANT) + || (finish && finish->expr_type != EXPR_CONSTANT) + || (step && step->expr_type != EXPR_CONSTANT)) + { + t = FAILURE; + goto cleanup; + } - if (mpz_cmp_ui (stride[d], 0) == 0) - mpz_set_ui (stride[d], one); + /* Obtain the stride. */ + if (step) + mpz_set (stride[d], step->value.integer); + else + mpz_set_ui (stride[d], one); - /* Obtain the start value for the index. */ - if (begin) - mpz_set (start[d], begin->value.integer); - else - mpz_set (start[d], lower->value.integer); + if (mpz_cmp_ui (stride[d], 0) == 0) + mpz_set_ui (stride[d], one); - mpz_set (ctr[d], start[d]); + /* Obtain the start value for the index. */ + if (begin) + mpz_set (start[d], begin->value.integer); + else + mpz_set (start[d], lower->value.integer); - /* Obtain the end value for the index. */ - if (finish) - mpz_set (end[d], finish->value.integer); - else - mpz_set (end[d], upper->value.integer); + mpz_set (ctr[d], start[d]); - /* Separate 'if' because elements sometimes arrive with - non-null end. */ - if (ref->u.ar.dimen_type[d] == DIMEN_ELEMENT) - mpz_set (end [d], begin->value.integer); + /* Obtain the end value for the index. */ + if (finish) + mpz_set (end[d], finish->value.integer); + else + mpz_set (end[d], upper->value.integer); + + /* Separate 'if' because elements sometimes arrive with + non-null end. */ + if (ref->u.ar.dimen_type[d] == DIMEN_ELEMENT) + mpz_set (end [d], begin->value.integer); + + /* Check the bounds. */ + if (mpz_cmp (ctr[d], upper->value.integer) > 0 + || mpz_cmp (end[d], upper->value.integer) > 0 + || mpz_cmp (ctr[d], lower->value.integer) < 0 + || mpz_cmp (end[d], lower->value.integer) < 0) + { + gfc_error ("index in dimension %d is out of bounds " + "at %L", d + 1, &ref->u.ar.c_where[d]); + t = FAILURE; + goto cleanup; + } - /* Check the bounds. */ - if (mpz_cmp (ctr[d], upper->value.integer) > 0 - || mpz_cmp (end[d], upper->value.integer) > 0 - || mpz_cmp (ctr[d], lower->value.integer) < 0 - || mpz_cmp (end[d], lower->value.integer) < 0) - { - gfc_error ("index in dimension %d is out of bounds " - "at %L", d + 1, &ref->u.ar.c_where[d]); - t = FAILURE; - goto cleanup; + /* Calculate the number of elements and the shape. */ + mpz_abs (tmp_mpz, stride[d]); + mpz_div (tmp_mpz, stride[d], tmp_mpz); + mpz_add (tmp_mpz, end[d], tmp_mpz); + mpz_sub (tmp_mpz, tmp_mpz, ctr[d]); + mpz_div (tmp_mpz, tmp_mpz, stride[d]); + mpz_mul (nelts, nelts, tmp_mpz); + + /* An element reference reduces the rank of the expression; don't add + anything to the shape array. */ + if (ref->u.ar.dimen_type[d] != DIMEN_ELEMENT) + mpz_set (expr->shape[shape_i++], tmp_mpz); } - /* Calculate the number of elements and the shape. */ - mpz_abs (tmp_mpz, stride[d]); - mpz_div (tmp_mpz, stride[d], tmp_mpz); - mpz_add (tmp_mpz, end[d], tmp_mpz); - mpz_sub (tmp_mpz, tmp_mpz, ctr[d]); - mpz_div (tmp_mpz, tmp_mpz, stride[d]); - mpz_mul (nelts, nelts, tmp_mpz); - - mpz_set (expr->shape[d], tmp_mpz); - /* Calculate the 'stride' (=delta) for conversion of the counter values into the index along the constructor. */ mpz_set (delta[d], delta_mpz); @@ -1137,7 +1172,6 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) mpz_init (index); mpz_init (ptr); - mpz_init (stop); cons = base; /* Now clock through the array reference, calculating the index in @@ -1150,7 +1184,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) else mpz_init_set_ui (ptr, 0); - mpz_set_ui (stop, one); + incr_ctr = true; for (d = 0; d < rank; d++) { mpz_set (tmp_mpz, ctr[d]); @@ -1158,16 +1192,32 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) mpz_mul (tmp_mpz, tmp_mpz, delta[d]); mpz_add (ptr, ptr, tmp_mpz); - mpz_mul (tmp_mpz, stride[d], stop); - mpz_add (ctr[d], ctr[d], tmp_mpz); + if (!incr_ctr) continue; + + if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */ + { + gcc_assert(vecsub[d]); - mpz_set (tmp_mpz, end[d]); - if (mpz_cmp_ui (stride[d], 0) > 0 ? - mpz_cmp (ctr[d], tmp_mpz) > 0 : - mpz_cmp (ctr[d], tmp_mpz) < 0) - mpz_set (ctr[d], start[d]); + if (!vecsub[d]->next) + vecsub[d] = ref->u.ar.start[d]->value.constructor; + else + { + vecsub[d] = vecsub[d]->next; + incr_ctr = false; + } + mpz_set (ctr[d], vecsub[d]->expr->value.integer); + } else - mpz_set_ui (stop, 0); + { + mpz_add (ctr[d], ctr[d], stride[d]); + + if (mpz_cmp_ui (stride[d], 0) > 0 ? + mpz_cmp (ctr[d], end[d]) > 0 : + mpz_cmp (ctr[d], end[d]) < 0) + mpz_set (ctr[d], start[d]); + else + incr_ctr = false; + } } /* There must be a better way of dealing with negative strides @@ -1189,7 +1239,6 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) mpz_clear (ptr); mpz_clear (index); - mpz_clear (stop); cleanup: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 90ec59b7f48..ae0c6e4012d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2006-11-06 Erik Edelmann + + PR fortran/29630 + PR fortran/29679 + * gfortran.dg/initialization_2.f90: Test PRs 29630 and 29679 too. + * gfortran.dg/initialization_3.f90: New. + 2006-11-05 Jerry DeLisle PR libgfortran/25545 diff --git a/gcc/testsuite/gfortran.dg/initialization_2.f90 b/gcc/testsuite/gfortran.dg/initialization_2.f90 index d5de85941d1..e13f38fb724 100644 --- a/gcc/testsuite/gfortran.dg/initialization_2.f90 +++ b/gcc/testsuite/gfortran.dg/initialization_2.f90 @@ -1,7 +1,22 @@ -! { dg-do compile } -! PR 29393: Ranks of PARAMETER-lhs in initializations - integer, parameter :: A(-3:7,2)=0 - integer, parameter, dimension(3) :: V = (/ 2, 4, 6 /) - integer, parameter, dimension(3) :: B = A(V,1) - integer, parameter, dimension(3) :: C = A(0:2,1) -end +! {dg-do run } +! Vector subscripts, ranks and shapes of initialization expressions (PRs 29393, +! 29630 and 29679) +program test + + implicit none + integer :: i, j + integer, parameter :: a(4,4,4) = reshape([ (i,i=1,64) ], [4,4,4]) + integer, parameter :: v(4) = [4, 1, 3, 2] + + integer :: b1(3,3) = a(1:3, 2, 2:4) + integer :: b2(1,3) = a(2:2, 4, [1,4,3]) + integer :: b2b(3) = a([1,4,3], 2, 4) + integer :: b3(4) = a(1, v, 3) + integer :: b4(3,3) = a(v([2,4,3]), 2, [2,3,4]) + + if (any(b1 /= reshape([21,22,23, 37,38,39, 53,54,55], [3,3]))) call abort() + if (any(b2 /= reshape([14, 62, 46], [1,3]))) call abort() + if (any(b2b /= [53, 56, 55])) call abort() + if (any(b3 /= [45, 33, 41, 37])) call abort() + if (any(b4 /= reshape([21,22,23, 37,38,39, 53,54,55], [3,3]))) call abort() +end program test diff --git a/gcc/testsuite/gfortran.dg/initialization_3.f90 b/gcc/testsuite/gfortran.dg/initialization_3.f90 new file mode 100644 index 00000000000..61b0f9f22b7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/initialization_3.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! Check that bounds are checked when using vector subscripts in initialization +! expressions. (PR 29630) +program test + + implicit none + integer :: i, j + integer, parameter :: a(4,4,4) = reshape([ (i,i=1,64) ], [4,4,4]) + integer, parameter :: v(4) = [5, 1, -4, 2] + + integer :: b2(3) = a(2, 4, [1,7,3]) ! { dg-error "out of bounds" } + integer :: b3(4) = a(1, v, 3) ! { dg-error "out of bounds" } +end program test