/* Supporting functions for resolving DATA statement.
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Contributed by Lifang Zeng <zlf605@hotmail.com>
GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
for more details.
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, 51 Franklin Street, Fifth Floor,Boston, MA
-02110-1301, USA. */
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
/* Notes for DATA statement implementation:
We first assign initial value to each symbol by gfc_assign_data_value
- during resolveing DATA statement. Refer to check_data_variable and
+ during resolving DATA statement. Refer to check_data_variable and
traverse_data_list in resolve.c.
The complexity exists in the handling of array section, implied do
#include "config.h"
#include "gfortran.h"
+#include "data.h"
static void formalize_init_expr (gfc_expr *);
{
gfc_expr *e;
int i;
- try re;
+ gfc_try re;
mpz_t delta;
mpz_t tmp;
/* 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
+ INIT is the existing initializer, not NULL. Initialization is performed
according to normal assignment rules. */
static gfc_expr *
create_character_intializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue)
{
- int len;
- int start;
- int end;
- char *dest, *rvalue_string;
+ int len, start, end;
+ gfc_char_t *dest;
- gfc_extract_int (ts->cl->length, &len);
+ gfc_extract_int (ts->u.cl->length, &len);
if (init == NULL)
{
init->expr_type = EXPR_CONSTANT;
init->ts = *ts;
- dest = gfc_getmem (len + 1);
+ dest = gfc_get_wide_string (len + 1);
dest[len] = '\0';
init->value.character.length = len;
init->value.character.string = dest;
/* Blank the string if we're only setting a substring. */
if (ref != NULL)
- memset (dest, ' ', len);
+ gfc_wide_memset (dest, ' ', len);
}
else
dest = init->value.character.string;
/* Copy the initial value. */
if (rvalue->ts.type == BT_HOLLERITH)
- {
- len = rvalue->representation.length;
- rvalue_string = rvalue->representation.string;
- }
+ len = rvalue->representation.length;
else
- {
- len = rvalue->value.character.length;
- rvalue_string = rvalue->value.character.string;
- }
+ len = rvalue->value.character.length;
if (len > end - start)
{
"at %L", &rvalue->where);
}
- memcpy (&dest[start], rvalue_string, len);
+ if (rvalue->ts.type == BT_HOLLERITH)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ dest[start+i] = rvalue->representation.string[i];
+ }
+ else
+ memcpy (&dest[start], rvalue->value.character.string,
+ len * sizeof (gfc_char_t));
/* Pad with spaces. Substrings will already be blanked. */
if (len < end - start && ref == NULL)
- memset (&dest[start + len], ' ', end - (start + len));
+ gfc_wide_memset (&dest[start + len], ' ', end - (start + len));
if (rvalue->ts.type == BT_HOLLERITH)
{
init->representation.length = init->value.character.length;
- init->representation.string = init->value.character.string;
+ init->representation.string
+ = gfc_widechar_to_char (init->value.character.string,
+ init->value.character.length);
}
return init;
LVALUE already has an initialization, we extend this, otherwise we
create a new one. */
-try
+gfc_try
gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
{
gfc_ref *ref;
else
mpz_set (offset, index);
+ /* Check the bounds. */
+ if (mpz_cmp_si (offset, 0) < 0)
+ {
+ gfc_error ("Data element below array lower bound at %L",
+ &lvalue->where);
+ return FAILURE;
+ }
+ else
+ {
+ mpz_t size;
+ if (spec_size (ref->u.ar.as, &size) == SUCCESS)
+ {
+ if (mpz_cmp (offset, size) >= 0)
+ {
+ mpz_clear (size);
+ gfc_error ("Data element above array upper bound at %L",
+ &lvalue->where);
+ return FAILURE;
+ }
+ mpz_clear (size);
+ }
+ }
+
/* Splay tree containing offset and gfc_constructor. */
spt = expr->con_by_offset;
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_STRUCTURE;
expr->ts.type = BT_DERIVED;
- expr->ts.derived = ref->u.c.sym;
+ expr->ts.u.derived = ref->u.c.sym;
}
else
gcc_assert (expr->expr_type == EXPR_STRUCTURE);
}
if (ref || last_ts->type == BT_CHARACTER)
- expr = create_character_intializer (init, last_ts, ref, rvalue);
+ {
+ if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+ return FAILURE;
+ expr = create_character_intializer (init, last_ts, ref, rvalue);
+ }
else
{
/* Overwriting an existing initializer is non-standard but usually only
/* 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. */
-#ifdef USE_MAPPED_LOCATION
expr = (LOCATION_LINE (init->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
? init : rvalue;
-#else
- expr = (init->where.lb->linenum > rvalue->where.lb->linenum)
- ? init : rvalue;
-#endif
gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
"of '%s' at %L", symbol->name, &expr->where);
}
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_STRUCTURE;
expr->ts.type = BT_DERIVED;
- expr->ts.derived = ref->u.c.sym;
+ expr->ts.u.derived = ref->u.c.sym;
}
else
gcc_assert (expr->expr_type == EXPR_STRUCTURE);
c = expr->value.constructor;
/* Constructor is already formalized. */
- if (c->n.component == NULL)
+ if (!c || c->n.component == NULL)
return;
head = tail = NULL;
- for (order = expr->ts.derived->components; order; order = order->next)
+ for (order = expr->ts.u.derived->components; order; order = order->next)
{
/* Find the next component. */
last = NULL;
}
-/* Make sure an initialization expression is in normalized form. Ie. all
+/* Make sure an initialization expression is in normalized form, i.e., all
elements of the constructors are in the correct order. */
static void
OSDN Git Service
