diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 63 |
1 files changed, 54 insertions, 9 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 91d05b3..89dea5f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14125,6 +14125,57 @@ resolve_fl_parameter (gfc_symbol *sym) } +/* Called by resolve_symbol to chack PDTs. */ + +static void +resolve_pdt (gfc_symbol* sym) +{ + gfc_symbol *derived = NULL; + gfc_actual_arglist *param; + gfc_component *c; + bool const_len_exprs = true; + bool assumed_len_exprs = false; + + if (sym->ts.type == BT_DERIVED) + derived = sym->ts.u.derived; + else if (sym->ts.type == BT_CLASS) + derived = CLASS_DATA (sym)->ts.u.derived; + else + gcc_unreachable (); + + gcc_assert (derived->attr.pdt_type); + + for (param = sym->param_list; param; param = param->next) + { + c = gfc_find_component (derived, param->name, false, true, NULL); + gcc_assert (c); + if (c->attr.pdt_kind) + continue; + + if (param->expr && !gfc_is_constant_expr (param->expr) + && c->attr.pdt_len) + const_len_exprs = false; + else if (param->spec_type == SPEC_ASSUMED) + assumed_len_exprs = true; + } + + if (!const_len_exprs + && (sym->ns->proc_name->attr.is_main_program + || sym->ns->proc_name->attr.flavor == FL_MODULE + || sym->attr.save != SAVE_NONE)) + gfc_error ("The AUTOMATIC object %qs at %L must not have the " + "SAVE attribute or be a variable declared in the " + "main program, a module or a submodule(F08/C513)", + sym->name, &sym->declared_at); + + if (assumed_len_exprs && !(sym->attr.dummy + || sym->attr.select_type_temporary || sym->attr.associate_var)) + gfc_error ("The object %qs at %L with ASSUMED type parameters " + "must be a dummy or a SELECT TYPE selector(F08/4.2)", + sym->name, &sym->declared_at); +} + + /* Do anything necessary to resolve a symbol. Right now, we just assume that an otherwise unknown symbol is a variable. This sort of thing commonly happens for symbols in module. */ @@ -14381,15 +14432,6 @@ resolve_symbol (gfc_symbol *sym) return; } - if (sym->attr.dummy && sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.pdt_type - && gfc_spec_list_type (sym->param_list, NULL) == SPEC_DEFERRED) - { - gfc_error ("%qs at %L cannot have DEFERRED type parameters because " - "it is a dummy argument", sym->name, &sym->declared_at); - return; - } - if (sym->attr.value && sym->ts.type == BT_CHARACTER) { gfc_charlen *cl = sym->ts.u.cl; @@ -14927,6 +14969,9 @@ resolve_symbol (gfc_symbol *sym) || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)) if (!resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name)) return; + + if (sym->param_list) + resolve_pdt (sym); } |