This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[fortran, patch] Fix PR24978, ICEs in DATA statements
- From: Daniel Franke <franke dot daniel at gmail dot com>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Fri, 30 Apr 2010 22:58:03 +0200
- Subject: [fortran, patch] Fix PR24978, ICEs in DATA statements
Hi all.
Attached patch fixes all the ICEs reported in PR24978 by removing the repeat-
count from the constructure structure and unrolling the repeats instead. This
simplifies the required checks significantly. However, I wouldn't be overly
surprised if this would cause some trouble with real-life code ...
There are too many errors in the testcase to match them all (especially
repeated errors for multiple re-initializations in the same statement), thus I
added a catch-all "dg-excess-errors" at the bottom.
There's still some room for improvement, e.g. one could short-cut
gfc_assign_data_value_range() if gfc_assign_data_value() returns FAILURE. Not
sure if this is necessary, though. Comments welcome :)
Bootstrapped and regression tested on i686-pc-linux-gnu.
Ok for trunk?
Daniel
gcc/fortran:
2010-04-30 Daniel Franke <franke.daniel@gmail.com>
PR fortran/24978
* gfortran.h: Removed repeat count from constructor,
removed all usages.
* 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.
gcc/testsuite:
2010-04-30 Daniel Franke <franke.daniel@gmail.com>
PR fortran/24978
* gfortran.dg/data_invalid.f90: New.
! { 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 "" }
Index: trans-array.c
===================================================================
--- trans-array.c (revision 158913)
+++ trans-array.c (working copy)
@@ -4133,11 +4133,10 @@ gfc_conv_array_initializer (tree type, g
{
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, g
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, g
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;
}
}
Index: array.c
===================================================================
--- array.c (revision 158913)
+++ array.c (working copy)
@@ -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
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;
Index: constructor.c
===================================================================
--- constructor.c (revision 158913)
+++ constructor.c (working copy)
@@ -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 *b
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_constru
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_
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;
}
Index: gfortran.h
===================================================================
--- gfortran.h (revision 158913)
+++ gfortran.h (working copy)
@@ -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;
Index: ChangeLog
===================================================================
--- ChangeLog (revision 158913)
+++ ChangeLog (working copy)
@@ -1,3 +1,11 @@
+2010-04-30 Daniel Franke <franke.daniel@gmail.com>
+
+ PR fortran/24978
+ * gfortran.h: Removed repeat count from constructor, removed all usages.
+ * 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.
+
2010-04-29 Janus Weil <janus@gcc.gnu.org>
PR fortran/43896
Index: data.c
===================================================================
--- data.c (revision 158913)
+++ data.c (working copy)
@@ -288,7 +288,7 @@ gfc_assign_data_value (gfc_expr *lvalue,
if (!con)
{
con = gfc_constructor_insert_expr (&expr->value.constructor,
- NULL, NULL,
+ NULL, &rvalue->where,
mpz_get_si (offset));
}
break;
@@ -371,149 +371,27 @@ gfc_assign_data_value (gfc_expr *lvalue,
/* 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_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);
+ mpz_t offset, last_offset;
- /* 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;
- }
-
- 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_init (offset);
+ mpz_init (last_offset);
+ mpz_add (last_offset, index, repeat);
+
+ for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0;
+ mpz_add_ui (offset, offset, 1))
+ gfc_assign_data_value (lvalue, rvalue, 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;
+ mpz_clear (offset);
+ mpz_clear (last_offset);
}
+
/* Modify the index of array section and re-calculate the array offset. */
void