diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 39 |
1 files changed, 33 insertions, 6 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d6da043..f770f60 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -833,10 +833,11 @@ resolve_contained_functions (gfc_namespace *ns) /* Resolve all of the elements of a structure constructor and make sure that - the types are correct. */ + the types are correct. The 'init' flag indicates that the given + constructor is an initializer. */ static gfc_try -resolve_structure_cons (gfc_expr *expr) +resolve_structure_cons (gfc_expr *expr, int init) { gfc_constructor *cons; gfc_component *comp; @@ -896,7 +897,8 @@ resolve_structure_cons (gfc_expr *expr) /* If we don't have the right type, try to convert it. */ - if (!gfc_compare_types (&cons->expr->ts, &comp->ts)) + if (!comp->attr.proc_pointer && + !gfc_compare_types (&cons->expr->ts, &comp->ts)) { t = FAILURE; if (strcmp (comp->name, "$extends") == 0) @@ -1005,6 +1007,23 @@ resolve_structure_cons (gfc_expr *expr) "a TARGET", &cons->expr->where, comp->name); } + if (init) + { + /* F08:C461. Additional checks for pointer initialization. */ + if (a.allocatable) + { + t = FAILURE; + gfc_error ("Pointer initialization target at %L " + "must not be ALLOCATABLE ", &cons->expr->where); + } + if (!a.save) + { + t = FAILURE; + gfc_error ("Pointer initialization target at %L " + "must have the SAVE attribute", &cons->expr->where); + } + } + /* F2003, C1272 (3). */ if (gfc_pure (NULL) && cons->expr->expr_type == EXPR_VARIABLE && (gfc_impure_variable (cons->expr->symtree->n.sym) @@ -1015,6 +1034,7 @@ resolve_structure_cons (gfc_expr *expr) "pointer component '%s' at %L in PURE procedure", comp->name, &cons->expr->where); } + } return t; @@ -5977,7 +5997,7 @@ gfc_resolve_expr (gfc_expr *e) if (t == FAILURE) break; - t = resolve_structure_cons (e); + t = resolve_structure_cons (e, 0); if (t == FAILURE) break; @@ -8924,10 +8944,17 @@ resolve_code (gfc_code *code, gfc_namespace *ns) static void resolve_values (gfc_symbol *sym) { + gfc_try t; + if (sym->value == NULL) return; - if (gfc_resolve_expr (sym->value) == FAILURE) + if (sym->value->expr_type == EXPR_STRUCTURE) + t= resolve_structure_cons (sym->value, 1); + else + t = gfc_resolve_expr (sym->value); + + if (t == FAILURE) return; gfc_check_assign_symbol (sym, sym->value); @@ -9636,7 +9663,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) return FAILURE; } - if (e && sym->attr.save && !gfc_is_constant_expr (e)) + if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e)) { gfc_error (auto_save_msg, sym->name, &sym->declared_at); return FAILURE; |