diff options
Diffstat (limited to 'gcc/fortran/data.c')
| -rw-r--r-- | gcc/fortran/data.c | 34 |
1 files changed, 21 insertions, 13 deletions
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 184e53d480f..5d1d38042f4 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -481,6 +481,21 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, mpz_clear (offset); gcc_assert (repeat == NULL); + /* Overwriting an existing initializer is non-standard but usually only + provokes a warning from other compilers. */ + if (init != NULL && init->where.lb && rvalue->where.lb) + { + /* 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 = (LOCATION_LINE (init->where.lb->location) + > LOCATION_LINE (rvalue->where.lb->location)) + ? init : rvalue; + if (gfc_notify_std (GFC_STD_GNU, "re-initialization of %qs at %L", + symbol->name, &expr->where) == false) + return false; + } + if (ref || last_ts->type == BT_CHARACTER) { /* An initializer has to be constant. */ @@ -492,20 +507,13 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, } else { - /* Overwriting an existing initializer is non-standard but usually only - provokes a warning from other compilers. */ - if (init != NULL) + if (lvalue->ts.type == BT_DERIVED + && gfc_has_default_initializer (lvalue->ts.u.derived)) { - /* 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 = (LOCATION_LINE (init->where.lb->location) - > LOCATION_LINE (rvalue->where.lb->location)) - ? init : rvalue; - if (gfc_notify_std (GFC_STD_GNU, - "re-initialization of %qs at %L", - symbol->name, &expr->where) == false) - return false; + gfc_error ("Nonpointer object %qs with default initialization " + "shall not appear in a DATA statement at %L", + symbol->name, &lvalue->where); + return false; } expr = gfc_copy_expr (rvalue); |