From e5880243049fd9d3992c86eb2f929abd3514153c Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Wed, 5 May 2010 14:53:23 -0400 Subject: [PATCH] re PR fortran/24978 (ICE in gfc_assign_data_value_range) gcc/fortran/: 2010-05-05 Daniel Franke PR fortran/24978 * gfortran.h: Removed repeat count from constructor, removed all usages. * data.h (gfc_assign_data_value_range): Changed return value from void to gfc_try. * data.c (gfc_assign_data_value): Add location to constructor element. (gfc_assign_data_value_range): Call gfc_assign_data_value() for each element in range. Return early if an error was generated. * resolve.c (check_data_variable): Stop early if range assignment generated an error. gcc/testsuite/: 2010-05-05 Daniel Franke PR fortran/24978 * gfortran.dg/data_invalid.f90: New. From-SVN: r159076 --- gcc/fortran/ChangeLog | 13 ++ gcc/fortran/array.c | 2 - gcc/fortran/constructor.c | 21 +-- gcc/fortran/data.c | 164 ++++----------------- gcc/fortran/data.h | 2 +- gcc/fortran/gfortran.h | 2 - gcc/fortran/resolve.c | 7 +- gcc/fortran/trans-array.c | 43 +----- gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gfortran.dg/data_invalid.f90 | 122 +++++++++++++++ 10 files changed, 176 insertions(+), 205 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/data_invalid.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0641cbfab67..090a4315c0c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2010-05-05 Daniel Franke + + PR fortran/24978 + * gfortran.h: Removed repeat count from constructor, removed + all usages. + * data.h (gfc_assign_data_value_range): Changed return value from + void to gfc_try. + * data.c (gfc_assign_data_value): Add location to constructor element. + (gfc_assign_data_value_range): Call gfc_assign_data_value() + for each element in range. Return early if an error was generated. + * resolve.c (check_data_variable): Stop early if range assignment + generated an error. + 2010-05-05 Janus Weil PR fortran/43696 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 5487be7aa4f..3ffc39714da 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1266,7 +1266,6 @@ typedef struct mpz_t *offset; gfc_component *component; - mpz_t *repeat; gfc_try (*expand_work_function) (gfc_expr *); } @@ -1501,7 +1500,6 @@ expand_constructor (gfc_constructor_base base) return FAILURE; } current_expand.offset = &c->offset; - current_expand.repeat = &c->repeat; current_expand.component = c->n.component; if (current_expand.expand_work_function (e) == FAILURE) return FAILURE; diff --git a/gcc/fortran/constructor.c b/gcc/fortran/constructor.c index 12bbdc4a5cb..45228b0c47c 100644 --- a/gcc/fortran/constructor.c +++ b/gcc/fortran/constructor.c @@ -36,7 +36,6 @@ node_free (splay_tree_value value) gfc_free_iterator (c->iterator, 1); mpz_clear (c->offset); - mpz_clear (c->repeat); gfc_free (c); } @@ -55,7 +54,6 @@ node_copy (splay_tree_node node, void *base) c->n.component = src->n.component; mpz_init_set (c->offset, src->offset); - mpz_init_set (c->repeat, src->repeat); return c; } @@ -80,7 +78,6 @@ gfc_constructor_get (void) c->iterator = NULL; mpz_init_set_si (c->offset, 0); - mpz_init_set_si (c->repeat, 0); return c; } @@ -172,7 +169,6 @@ gfc_constructor_insert_expr (gfc_constructor_base *base, gfc_constructor * gfc_constructor_lookup (gfc_constructor_base base, int offset) { - gfc_constructor *c; splay_tree_node node; if (!base) @@ -182,22 +178,7 @@ gfc_constructor_lookup (gfc_constructor_base base, int offset) if (node) return (gfc_constructor*) node->value; - /* Check if the previous node has a repeat count big enough to - cover the offset looked for. */ - node = splay_tree_predecessor (base, offset); - if (!node) - return NULL; - - c = (gfc_constructor*) node->value; - if (mpz_cmp_si (c->repeat, 1) > 0) - { - if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset) - c = NULL; - } - else - c = NULL; - - return c; + return NULL; } diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index fca251cb660..c217e1cab0e 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -288,7 +288,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index) if (!con) { con = gfc_constructor_insert_expr (&expr->value.constructor, - NULL, NULL, + NULL, &rvalue->where, mpz_get_si (offset)); } break; @@ -352,8 +352,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index) expr = (LOCATION_LINE (init->where.lb->location) > LOCATION_LINE (rvalue->where.lb->location)) ? init : rvalue; - gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization " - "of '%s' at %L", symbol->name, &expr->where); + if (gfc_notify_std (GFC_STD_GNU,"Extension: " + "re-initialization of '%s' at %L", + symbol->name, &expr->where) == FAILURE) + return FAILURE; } expr = gfc_copy_expr (rvalue); @@ -371,149 +373,35 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index) /* Similarly, but initialize REPEAT consecutive values in LVALUE the same - value in RVALUE. For the nonce, LVALUE must refer to a full array, not - an array section. */ + value in RVALUE. */ -void +gfc_try gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, mpz_t repeat) { - gfc_ref *ref; - gfc_expr *init, *expr; - gfc_constructor *con, *last_con; - gfc_symbol *symbol; - gfc_typespec *last_ts; - mpz_t offset; - - symbol = lvalue->symtree->n.sym; - init = symbol->value; - last_ts = &symbol->ts; - last_con = NULL; - mpz_init_set_si (offset, 0); - - /* Find/create the parent expressions for subobject references. */ - for (ref = lvalue->ref; ref; ref = ref->next) - { - /* Use the existing initializer expression if it exists. - Otherwise create a new one. */ - if (init == NULL) - expr = gfc_get_expr (); - else - expr = init; - - /* Find or create this element. */ - switch (ref->type) - { - case REF_ARRAY: - if (init == NULL) - { - /* The element typespec will be the same as the array - typespec. */ - expr->ts = *last_ts; - /* Setup the expression to hold the constructor. */ - expr->expr_type = EXPR_ARRAY; - expr->rank = ref->u.ar.as->rank; - } - else - gcc_assert (expr->expr_type == EXPR_ARRAY); - - if (ref->u.ar.type == AR_ELEMENT) - { - get_array_index (&ref->u.ar, &offset); - - /* This had better not be the bottom of the reference. - We can still get to a full array via a component. */ - gcc_assert (ref->next != NULL); - } - else - { - mpz_set (offset, index); - - /* We're at a full array or an array section. This means - that we've better have found a full array, and that we're - at the bottom of the reference. */ - gcc_assert (ref->u.ar.type == AR_FULL); - gcc_assert (ref->next == NULL); - } - - con = gfc_constructor_lookup (expr->value.constructor, - mpz_get_si (offset)); - if (con == NULL) - { - con = gfc_constructor_insert_expr (&expr->value.constructor, - NULL, NULL, - mpz_get_si (offset)); - if (ref->next == NULL) - mpz_set (con->repeat, repeat); - } - else - gcc_assert (ref->next != NULL); - break; - - case REF_COMPONENT: - if (init == NULL) - { - /* Setup the expression to hold the constructor. */ - expr->expr_type = EXPR_STRUCTURE; - expr->ts.type = BT_DERIVED; - expr->ts.u.derived = ref->u.c.sym; - } - else - gcc_assert (expr->expr_type == EXPR_STRUCTURE); - last_ts = &ref->u.c.component->ts; - - /* Find the same element in the existing constructor. */ - con = find_con_by_component (ref->u.c.component, - expr->value.constructor); - - if (con == NULL) - { - /* Create a new constructor. */ - con = gfc_constructor_append_expr (&expr->value.constructor, - NULL, NULL); - con->n.component = ref->u.c.component; - } - - /* Since we're only intending to initialize arrays here, - there better be an inner reference. */ - gcc_assert (ref->next != NULL); - break; - - case REF_SUBSTRING: - default: - gcc_unreachable (); - } - - if (init == NULL) - { - /* Point the container at the new expression. */ - if (last_con == NULL) - symbol->value = expr; - else - last_con->expr = expr; - } - init = con->expr; - last_con = con; - } + mpz_t offset, last_offset; + gfc_try t; + + mpz_init (offset); + mpz_init (last_offset); + mpz_add (last_offset, index, repeat); + + t = SUCCESS; + for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0; + mpz_add_ui (offset, offset, 1)) + if (gfc_assign_data_value (lvalue, rvalue, offset) == FAILURE) + { + t = FAILURE; + break; + } - if (last_ts->type == BT_CHARACTER) - expr = create_character_intializer (init, last_ts, NULL, rvalue); - else - { - /* We should never be overwriting an existing initializer. */ - gcc_assert (!init); + mpz_clear (offset); + mpz_clear (last_offset); - expr = gfc_copy_expr (rvalue); - if (!gfc_compare_types (&lvalue->ts, &expr->ts)) - gfc_convert_type (expr, &lvalue->ts, 0); - } - - if (last_con == NULL) - symbol->value = expr; - else - last_con->expr = expr; + return t; } + /* Modify the index of array section and re-calculate the array offset. */ void diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h index 0d31a920e6d..c54c75de9c0 100644 --- a/gcc/fortran/data.h +++ b/gcc/fortran/data.h @@ -20,5 +20,5 @@ along with GCC; see the file COPYING3. If not see void gfc_formalize_init_value (gfc_symbol *); void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *); gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t); -void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t); +gfc_try gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t); void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 11ce974b7b8..827a13f4dc2 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2187,8 +2187,6 @@ typedef struct gfc_constructor gfc_component *component; /* Record the component being initialized. */ } n; - mpz_t repeat; /* Record the repeat number of initial values in data - statement like "data a/5*10/". */ } gfc_constructor; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d92c69c030c..2c79863a718 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11781,11 +11781,14 @@ check_data_variable (gfc_data_variable *var, locus *where) mpz_set_ui (size, 0); } - gfc_assign_data_value_range (var->expr, values.vnode->expr, - offset, range); + t = gfc_assign_data_value_range (var->expr, values.vnode->expr, + offset, range); mpz_add (offset, offset, range); mpz_clear (range); + + if (t == FAILURE) + break; } /* Assign initial value to symbol. */ diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e20406c9451..8ece64327af 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4133,11 +4133,10 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) { gfc_constructor *c; tree tmp; - mpz_t maxval; gfc_se se; HOST_WIDE_INT hi; unsigned HOST_WIDE_INT lo; - tree index, range; + tree index; VEC(constructor_elt,gc) *v = NULL; switch (expr->expr_type) @@ -4190,42 +4189,13 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) index = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind); else index = NULL_TREE; - mpz_init (maxval); - if (mpz_cmp_si (c->repeat, 0) != 0) - { - tree tmp1, tmp2; - - mpz_set (maxval, c->repeat); - mpz_add (maxval, c->offset, maxval); - mpz_sub_ui (maxval, maxval, 1); - tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind); - if (mpz_cmp_si (c->offset, 0) != 0) - { - mpz_add_ui (maxval, c->offset, 1); - tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind); - } - else - tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind); - - range = fold_build2 (RANGE_EXPR, integer_type_node, tmp1, tmp2); - } - else - range = NULL; - mpz_clear (maxval); gfc_init_se (&se, NULL); switch (c->expr->expr_type) { case EXPR_CONSTANT: gfc_conv_constant (&se, c->expr); - if (range == NULL_TREE) - CONSTRUCTOR_APPEND_ELT (v, index, se.expr); - else - { - if (index != NULL_TREE) - CONSTRUCTOR_APPEND_ELT (v, index, se.expr); - CONSTRUCTOR_APPEND_ELT (v, range, se.expr); - } + CONSTRUCTOR_APPEND_ELT (v, index, se.expr); break; case EXPR_STRUCTURE: @@ -4239,14 +4209,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) for one reason or another, assuming that if they are standard defying the frontend will catch them. */ gfc_conv_expr (&se, c->expr); - if (range == NULL_TREE) - CONSTRUCTOR_APPEND_ELT (v, index, se.expr); - else - { - if (index != NULL_TREE) - CONSTRUCTOR_APPEND_ELT (v, index, se.expr); - CONSTRUCTOR_APPEND_ELT (v, range, se.expr); - } + CONSTRUCTOR_APPEND_ELT (v, index, se.expr); break; } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9cee6901d9d..3ff322094b3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-05-05 Daniel Franke + + PR fortran/24978 + * gfortran.dg/data_invalid.f90: New. + 2010-05-05 Eric Botcazou * gnat.dg/lto2.adb: New test. diff --git a/gcc/testsuite/gfortran.dg/data_invalid.f90 b/gcc/testsuite/gfortran.dg/data_invalid.f90 new file mode 100644 index 00000000000..10ea7e57c08 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_invalid.f90 @@ -0,0 +1,122 @@ +! { dg-do "compile" } +! { dg-options "-std=f95 -fmax-errors=0" } +! +! Testcases from PR fortran/24978 +! + +SUBROUTINE data_init_scalar_invalid() + integer :: a + data a / 1 / + data a / 1 / ! { dg-error "re-initialization" } + + integer :: b = 0 + data b / 1 / ! { dg-error "re-initialization" } +END SUBROUTINE + +SUBROUTINE data_init_array_invalid() + ! initialize (at least) one element, re-initialize full array + integer :: a(3) + data a(2) / 2 / + data a / 3*1 / ! { dg-error "re-initialization" } + + ! initialize (at least) one element, re-initialize subsection including the element + integer :: b(3) + data b(2) / 2 / + data b(1:2) / 2*1 / ! { dg-error "re-initialization" } + + ! initialize subsection, re-initialize (intersecting) subsection + integer :: c(3) + data c(1:2) / 2*1 / + data c(2:3) / 1,1 / ! { dg-error "re-initialization" } + + ! initialize subsection, re-initialize full array + integer :: d(3) + data d(2:3) / 2*1 / + data d / 2*2, 3 / ! { dg-error "re-initialization" } + + ! full array initializer, re-initialize (at least) one element + integer :: e(3) + data e / 3*1 / + data e(2) / 2 / ! { dg-error "re-initialization" } + + integer :: f(3) = 0 ! { dg-error "already is initialized" } + data f(2) / 1 / + + ! full array initializer, re-initialize subsection + integer :: g(3) + data g / 3*1 / + data g(1:2) / 2*2 / ! { dg-error "re-initialization" } + + integer :: h(3) = 1 ! { dg-error "already is initialized" } + data h(2:3) / 2*2 / + + ! full array initializer, re-initialize full array + integer :: i(3) + data i / 3*1 / + data i / 2,2,2 / ! { dg-error "re-initialization" } + + integer :: j(3) = 1 ! { dg-error "already is initialized" } + data j / 3*2 / +END SUBROUTINE + +SUBROUTINE data_init_matrix_invalid() + ! initialize (at least) one element, re-initialize full matrix + integer :: a(3,3) + data a(2,2) / 1 / + data a / 9*2 / ! { dg-error "re-initialization" } + + ! initialize (at least) one element, re-initialize subsection + integer :: b(3,3) + data b(2,2) / 1 / + data b(2,:) / 3*2 / ! { dg-error "re-initialization" } + + ! initialize subsection, re-initialize (intersecting) subsection + integer :: c(3,3) + data c(3,:) / 3*1 /, c(:,3) / 3*2 / ! { dg-error "re-initialization" } + + ! initialize subsection, re-initialize full array + integer :: d(3,3) + data d(2,:) / 1,2,3 / + data d / 9*4 / ! { dg-error "re-initialization" } + + ! full array initializer, re-initialize (at least) one element + integer :: e(3,3) + data e / 9*1 / + data e(2,3) / 2 / ! { dg-error "re-initialization" } + + integer :: f(3,3) = 1 ! { dg-error "already is initialized" } + data f(3,2) / 2 / + + ! full array initializer, re-initialize subsection + integer :: g(3,3) + data g / 9 * 1 / + data g(2:3,2:3) / 2, 2*3, 4 / ! { dg-error "re-initialization" } + + integer :: h(3,3) = 1 ! { dg-error "already is initialized" } + data h(2:3,2:3) / 2, 2*3, 4 / + + ! full array initializer, re-initialize full array + integer :: i(3,3) + data i / 3*1, 3*2, 3*3 / + data i / 9 * 1 / ! { dg-error "re-initialization" } + + integer :: j(3,3) = 0 ! { dg-error "already is initialized" } + data j / 9 * 1 / +END SUBROUTINE + +SUBROUTINE data_init_misc_invalid() + ! wrong number of dimensions + integer :: a(3) + data a(1,1) / 1 / ! { dg-error "Rank mismatch" } + + ! index out-of-bounds, direct access + integer :: b(3) + data b(-2) / 1 / ! { dg-error "below array lower bound" } + + ! index out-of-bounds, implied do-loop (PR32315) + integer :: i + character(len=20), dimension(4) :: string + data (string(i), i = 1, 5) / 'A', 'B', 'C', 'D', 'E' / ! { dg-error "above array upper bound" } +END SUBROUTINE + +! { dg-excess-errors "" } -- 2.30.2