This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [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: Sun, 2 May 2010 11:31:58 +0200
- Subject: Re: [fortran, patch] Fix PR24978, ICEs in DATA statements
- References: <201004302258.04389.franke.daniel@gmail.com>
On Friday 30 April 2010 22:58:03 Daniel Franke wrote:
> 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 :)
Updated patch. Dominique was not happy with the multiplication of errors, so I
changed it that only one warning/error is generated, regardless of the number
of re-initializations.
> 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.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-04-30 Daniel Franke <franke.daniel@gmail.com>
>
> PR fortran/24978
> * gfortran.dg/data_invalid.f90: New.
Bootstrapped and regression tested on i686-pc-linux-gnu by me and darwin-
something by Dominique. Ok for trunk?
Cheers
Daniel
Index: gfortran.h
===================================================================
--- gfortran.h (revision 158965)
+++ 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: array.c
===================================================================
--- array.c (revision 158965)
+++ 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: trans-array.c
===================================================================
--- trans-array.c (revision 158965)
+++ 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: constructor.c
===================================================================
--- constructor.c (revision 158965)
+++ 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: data.h
===================================================================
--- data.h (revision 158965)
+++ data.h (working copy)
@@ -20,5 +20,5 @@ along with GCC; see the file COPYING3.
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 *);
Index: data.c
===================================================================
--- data.c (revision 158965)
+++ 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;
@@ -352,8 +352,10 @@ gfc_assign_data_value (gfc_expr *lvalue,
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,
/* 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;
+ mpz_t offset, last_offset;
+ gfc_try t;
- /* 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);
+
+ 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;
+ }
- expr = gfc_copy_expr (rvalue);
- if (!gfc_compare_types (&lvalue->ts, &expr->ts))
- gfc_convert_type (expr, &lvalue->ts, 0);
- }
+ mpz_clear (offset);
+ mpz_clear (last_offset);
- 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
Index: resolve.c
===================================================================
--- resolve.c (revision 158965)
+++ resolve.c (working copy)
@@ -11771,11 +11771,14 @@ check_data_variable (gfc_data_variable *
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. */