/* Supporting functions for resolving DATA statement.
- Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Lifang Zeng <zlf605@hotmail.com>
This file is part of GCC.
You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330,Boston, MA
-02111-1307, USA. */
+Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA
+02110-1301, USA. */
/* Notes for DATA statement implementation:
during resolveing DATA statement. Refer to check_data_variable and
traverse_data_list in resolve.c.
- The complexity exists in the handleing of array section, implied do
+ The complexity exists in the handling of array section, implied do
and array of struct appeared in DATA statement.
We call gfc_conv_structure, gfc_con_array_array_initializer,
#include "config.h"
#include "gfortran.h"
-#include "assert.h"
static void formalize_init_expr (gfc_expr *);
}
-/* Create a character type intialization expression from RVALUE.
+/* Create a character type initialization expression from RVALUE.
TS [and REF] describe [the substring of] the variable being initialized.
INIT is thh existing initializer, not NULL. Initialization is performed
according to normal assignment rules. */
if (ref)
{
- assert (ref->type == REF_SUBSTRING);
+ gcc_assert (ref->type == REF_SUBSTRING);
/* Only set a substring of the destination. Fortran substring bounds
are one-based [start, end], we want zero based [start, end). */
if (ref->type == REF_SUBSTRING)
{
/* A substring should always br the last subobject reference. */
- assert (ref->next == NULL);
+ gcc_assert (ref->next == NULL);
break;
}
expr->rank = ref->u.ar.as->rank;
}
else
- assert (expr->expr_type == EXPR_ARRAY);
+ gcc_assert (expr->expr_type == EXPR_ARRAY);
if (ref->u.ar.type == AR_ELEMENT)
get_array_index (&ref->u.ar, &offset);
expr->ts.derived = ref->u.c.sym;
}
else
- assert (expr->expr_type == EXPR_STRUCTURE);
+ gcc_assert (expr->expr_type == EXPR_STRUCTURE);
last_ts = &ref->u.c.component->ts;
/* Find the same element in the existing constructor. */
break;
default:
- abort ();
+ gcc_unreachable ();
}
if (init == NULL)
expr = create_character_intializer (init, last_ts, ref, rvalue);
else
{
- /* We should never be overwriting an existing initializer. */
- assert (!init);
+ /* Overwriting an existing initializer is non-standard but usually only
+ provokes a warning from other compilers. */
+ if (init != NULL)
+ {
+ /* Order in which the expressions arrive here depends on whether they
+ are from data statements or F95 style declarations. Therefore,
+ check which is the most recent. */
+ expr = (init->where.lb->linenum > rvalue->where.lb->linenum) ?
+ init : rvalue;
+ gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
+ "of '%s' at %L", symbol->name, &expr->where);
+ return;
+ }
expr = gfc_copy_expr (rvalue);
if (!gfc_compare_types (&lvalue->ts, &expr->ts))
last_con->expr = expr;
}
-/* Similarly, but initialize REPEAT consectutive values in LVALUE the same
+/* 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. */
expr->rank = ref->u.ar.as->rank;
}
else
- assert (expr->expr_type == EXPR_ARRAY);
+ gcc_assert (expr->expr_type == EXPR_ARRAY);
if (ref->u.ar.type == AR_ELEMENT)
{
/* This had better not be the bottom of the reference.
We can still get to a full array via a component. */
- assert (ref->next != NULL);
+ gcc_assert (ref->next != NULL);
}
else
{
/* 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. */
- assert (ref->u.ar.type == AR_FULL);
- assert (ref->next == NULL);
+ gcc_assert (ref->u.ar.type == AR_FULL);
+ gcc_assert (ref->next == NULL);
}
/* Find the same element in the existing constructor. */
gfc_insert_constructor (expr, con);
}
else
- assert (ref->next != NULL);
+ gcc_assert (ref->next != NULL);
break;
case REF_COMPONENT:
expr->ts.derived = ref->u.c.sym;
}
else
- assert (expr->expr_type == EXPR_STRUCTURE);
+ gcc_assert (expr->expr_type == EXPR_STRUCTURE);
last_ts = &ref->u.c.component->ts;
/* Find the same element in the existing constructor. */
/* Since we're only intending to initialize arrays here,
there better be an inner reference. */
- assert (ref->next != NULL);
+ gcc_assert (ref->next != NULL);
break;
case REF_SUBSTRING:
default:
- abort ();
+ gcc_unreachable ();
}
if (init == NULL)
last_con = con;
}
- /* We should never be overwriting an existing initializer. */
- assert (!init);
+ 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);
- expr = gfc_copy_expr (rvalue);
- if (!gfc_compare_types (&lvalue->ts, &expr->ts))
- gfc_convert_type (expr, &lvalue->ts, 0);
+ 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;
/* Rearrange a structure constructor so the elements are in the specified
- order. Also insert NULL entries if neccessary. */
+ order. Also insert NULL entries if necessary. */
static void
formalize_structure_cons (gfc_expr * expr)
c = expr->value.constructor;
- /* Constructor is already fomalized. */
+ /* Constructor is already formalized. */
if (c->n.component == NULL)
return;
tail = tail->next;
}
}
- assert (c == NULL);
+ gcc_assert (c == NULL);
expr->value.constructor = head;
}
gfc_internal_error ("TODO: Vector sections in data statements");
default:
- abort ();
+ gcc_unreachable ();
}
mpz_sub (tmp, ar->as->upper[i]->value.integer,
OSDN Git Service
