trans-array.c. */
#include "config.h"
+#include "system.h"
#include "gfortran.h"
#include "data.h"
#include "constructor.h"
according to normal assignment rules. */
static gfc_expr *
-create_character_intializer (gfc_expr *init, gfc_typespec *ts,
- gfc_ref *ref, gfc_expr *rvalue)
+create_character_initializer (gfc_expr *init, gfc_typespec *ts,
+ gfc_ref *ref, gfc_expr *rvalue)
{
int len, start, end;
gfc_char_t *dest;
/* Copy the initial value. */
if (rvalue->ts.type == BT_HOLLERITH)
- len = rvalue->representation.length;
+ len = rvalue->representation.length - rvalue->ts.u.pad;
else
len = rvalue->value.character.length;
if (len > end - start)
{
+ gfc_warning_now ("Initialization string starting at %L was "
+ "truncated to fit the variable (%d/%d)",
+ &rvalue->where, end - start, len);
len = end - start;
- gfc_warning_now ("initialization string truncated to match variable "
- "at %L", &rvalue->where);
}
if (rvalue->ts.type == BT_HOLLERITH)
gfc_error ("'%s' at %L already is initialized at %L",
lvalue->symtree->n.sym->name, &lvalue->where,
&init->where);
- return FAILURE;
+ goto abort;
}
if (init == NULL)
{
gfc_error ("Data element below array lower bound at %L",
&lvalue->where);
- return FAILURE;
+ goto abort;
}
else
{
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);
+ gfc_error ("Data element above array upper bound at %L",
+ &lvalue->where);
+ goto abort;
+ }
mpz_clear (size);
}
}
last_con = con;
}
+ mpz_clear (offset);
+
if (ref || last_ts->type == BT_CHARACTER)
{
if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
return FAILURE;
- expr = create_character_intializer (init, last_ts, ref, rvalue);
+ expr = create_character_initializer (init, last_ts, ref, rvalue);
}
else
{
last_con->expr = expr;
return SUCCESS;
+
+abort:
+ mpz_clear (offset);
+ return FAILURE;
}