[patch,fortran] PRs 29630 & 29679: Vector subscripts and shapes in initialization expressions
Paul Thomas
paulthomas2@wanadoo.fr
Mon Nov 6 20:19:00 GMT 2006
Erik,
:REVIEWMAIL:
Sorry to be a little while getting back to you.
It looks as if the patch is up to your usual high standard - OK to commit.
Paul
> On Sat, Nov 04, 2006 at 07:32:45AM +0100, Paul Thomas wrote:
>
>> Erik Edelmann wrote:
>>
>>> :ADDPATCH fortran:
>>>
>> I don't think that you did.......
>>
>
> Oh, sorry! Here it comes.
>
>
> Erik
>
> ------------------------------------------------------------------------
>
> Index: gcc/testsuite/gfortran.dg/initialization_2.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/initialization_2.f90 (revision 118464)
> +++ gcc/testsuite/gfortran.dg/initialization_2.f90 (working copy)
> @@ -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
> Index: gcc/testsuite/gfortran.dg/initialization_3.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/initialization_3.f90 (revision 0)
> +++ gcc/testsuite/gfortran.dg/initialization_3.f90 (revision 0)
> @@ -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
> Index: gcc/fortran/expr.c
> ===================================================================
> --- gcc/fortran/expr.c (revision 118464)
> +++ gcc/fortran/expr.c (working copy)
> @@ -1013,7 +1013,9 @@ find_array_section (gfc_expr *expr, gfc_
> 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_
> 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_
> 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_
> 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,63 +1073,94 @@ find_array_section (gfc_expr *expr, gfc_
> 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;
> - }
> + 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]);
>
> - /* Obtain the stride. */
> - if (step)
> - mpz_set (stride[d], step->value.integer);
> + /* 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);
> -
> - /* 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;
> - }
> + /* Obtain the end value for the index. */
> + if (finish)
> + mpz_set (end[d], finish->value.integer);
> + else
> + mpz_set (end[d], upper->value.integer);
>
> - /* 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);
> + /* 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;
> + }
>
> - mpz_set (expr->shape[d], 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);
> +
> + /* 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 'stride' (=delta) for conversion of the
> counter values into the index along the constructor. */
> @@ -1137,7 +1172,6 @@ find_array_section (gfc_expr *expr, gfc_
>
> 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_
> 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_
> 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;
>
> - 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 (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */
> + {
> + gcc_assert(vecsub[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_
>
> mpz_clear (ptr);
> mpz_clear (index);
> - mpz_clear (stop);
>
> cleanup:
>
>
More information about the Fortran
mailing list