Index: gcc/fortran/dependency.c =================================================================== --- gcc/fortran/dependency.c (revision 195493) +++ gcc/fortran/dependency.c (working copy) @@ -822,7 +822,7 @@ gfc_check_fncall_dependency (gfc_expr *other, sym_ gfc_formal_arglist *formal; gfc_expr *expr; - formal = fnsym ? fnsym->formal : NULL; + formal = fnsym ? gfc_sym_get_dummy_args (fnsym) : NULL; for (; actual; actual = actual->next, formal = formal ? formal->next : NULL) { expr = actual->expr; Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (revision 195493) +++ gcc/fortran/expr.c (working copy) @@ -934,7 +934,7 @@ gfc_is_constant_expr (gfc_expr *e) && sym->attr.proc != PROC_INTERNAL && sym->attr.proc != PROC_ST_FUNCTION && sym->attr.proc != PROC_UNKNOWN - && sym->formal == NULL) + && gfc_sym_get_dummy_args (sym) == NULL) return 1; if (e->value.function.isym @@ -4301,72 +4301,6 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* } -/* Walk an expression tree and replace all dummy symbols by the corresponding - symbol in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE - statements. The boolean return value is required by gfc_traverse_expr. */ - -static bool -replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED) -{ - if ((expr->expr_type == EXPR_VARIABLE - || (expr->expr_type == EXPR_FUNCTION - && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) - && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns - && expr->symtree->n.sym->attr.dummy) - { - gfc_symtree *root = sym->formal_ns ? sym->formal_ns->sym_root - : gfc_current_ns->sym_root; - gfc_symtree *stree = gfc_find_symtree (root, expr->symtree->n.sym->name); - gcc_assert (stree); - stree->n.sym->attr = expr->symtree->n.sym->attr; - expr->symtree = stree; - } - return false; -} - -void -gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest) -{ - gfc_traverse_expr (expr, dest, &replace_symbol, 0); -} - - -/* The following is analogous to 'replace_symbol', and needed for copying - interfaces for procedure pointer components. The argument 'sym' must formally - be a gfc_symbol, so that the function can be passed to gfc_traverse_expr. - However, it gets actually passed a gfc_component (i.e. the procedure pointer - component in whose formal_ns the arguments have to be). */ - -static bool -replace_comp (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED) -{ - gfc_component *comp; - comp = (gfc_component *)sym; - if ((expr->expr_type == EXPR_VARIABLE - || (expr->expr_type == EXPR_FUNCTION - && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where))) - && expr->symtree->n.sym->ns == comp->ts.interface->formal_ns) - { - gfc_symtree *stree; - gfc_namespace *ns = comp->formal_ns; - /* Don't use gfc_get_symtree as we prefer to fail badly if we don't find - the symtree rather than create a new one (and probably fail later). */ - stree = gfc_find_symtree (ns ? ns->sym_root : gfc_current_ns->sym_root, - expr->symtree->n.sym->name); - gcc_assert (stree); - stree->n.sym->attr = expr->symtree->n.sym->attr; - expr->symtree = stree; - } - return false; -} - -void -gfc_expr_replace_comp (gfc_expr *expr, gfc_component *dest) -{ - gfc_traverse_expr (expr, (gfc_symbol *)dest, &replace_comp, 0); -} - - bool gfc_ref_this_image (gfc_ref *ref) { Index: gcc/fortran/frontend-passes.c =================================================================== --- gcc/fortran/frontend-passes.c (revision 195493) +++ gcc/fortran/frontend-passes.c (working copy) @@ -1447,7 +1447,7 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTR if (co->resolved_sym == NULL) break; - f = co->resolved_sym->formal; + f = gfc_sym_get_dummy_args (co->resolved_sym); /* Withot a formal arglist, there is only unknown INTENT, which we don't check for. */ @@ -1516,7 +1516,7 @@ do_function (gfc_expr **e, int *walk_subtrees ATTR if (expr->value.function.isym) return 0; - f = expr->symtree->n.sym->formal; + f = gfc_sym_get_dummy_args (expr->symtree->n.sym); /* Without a formal arglist, there is only unknown INTENT, which we don't check for. */ Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 195493) +++ gcc/fortran/gfortran.h (working copy) @@ -974,8 +974,6 @@ typedef struct gfc_component struct gfc_component *next; /* Needed for procedure pointer components. */ - struct gfc_formal_arglist *formal; - struct gfc_namespace *formal_ns; struct gfc_typebound_proc *tb; } gfc_component; @@ -2659,9 +2657,7 @@ gfc_symbol* gfc_get_ultimate_derived_super_type (g bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *); bool gfc_type_compatible (gfc_typespec *, gfc_typespec *); -void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *, ifsrc); void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *); -void gfc_copy_formal_args_ppc (gfc_component *, gfc_symbol *, ifsrc); void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */ @@ -2670,6 +2666,7 @@ gfc_namespace* gfc_find_proc_namespace (gfc_namesp bool gfc_is_associate_pointer (gfc_symbol*); gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *); +gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *); /* intrinsic.c -- true if working in an init-expr, false otherwise. */ extern bool gfc_init_expr_flag; @@ -2784,8 +2781,6 @@ bool gfc_traverse_expr (gfc_expr *, gfc_symbol *, int); void gfc_expr_set_symbols_referenced (gfc_expr *); gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool); -void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *); -void gfc_expr_replace_comp (gfc_expr *, gfc_component *); gfc_component * gfc_get_proc_ptr_comp (gfc_expr *); bool gfc_is_proc_ptr_comp (gfc_expr *); Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 195493) +++ gcc/fortran/interface.c (working copy) @@ -616,7 +616,7 @@ gfc_check_operator_interface (gfc_symbol *sym, gfc r1 = r2 = -1; k1 = k2 = -1; - for (formal = sym->formal; formal; formal = formal->next) + for (formal = gfc_sym_get_dummy_args (sym); formal; formal = formal->next) { gfc_symbol *fsym = formal->sym; if (fsym == NULL) @@ -662,6 +662,8 @@ gfc_check_operator_interface (gfc_symbol *sym, gfc INTRINSIC_ASSIGN which should map to a subroutine. */ if (op == INTRINSIC_ASSIGN) { + gfc_formal_arglist *dummy_args; + if (!sym->attr.subroutine) { gfc_error ("Assignment operator interface at %L must be " @@ -674,12 +676,13 @@ gfc_check_operator_interface (gfc_symbol *sym, gfc - First argument is a scalar and second an array, - Types and kinds do not conform, or - First argument is of derived type. */ - if (sym->formal->sym->ts.type != BT_DERIVED - && sym->formal->sym->ts.type != BT_CLASS + dummy_args = gfc_sym_get_dummy_args (sym); + if (dummy_args->sym->ts.type != BT_DERIVED + && dummy_args->sym->ts.type != BT_CLASS && (r2 == 0 || r1 == r2) - && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type - || (gfc_numeric_ts (&sym->formal->sym->ts) - && gfc_numeric_ts (&sym->formal->next->sym->ts)))) + && (dummy_args->sym->ts.type == dummy_args->next->sym->ts.type + || (gfc_numeric_ts (&dummy_args->sym->ts) + && gfc_numeric_ts (&dummy_args->next->sym->ts)))) { gfc_error ("Assignment operator interface at %L must not redefine " "an INTRINSIC type assignment", &sym->declared_at); @@ -1377,8 +1380,8 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol || s2->attr.if_source == IFSRC_UNKNOWN) return 1; - f1 = s1->formal; - f2 = s2->formal; + f1 = gfc_sym_get_dummy_args (s1); + f2 = gfc_sym_get_dummy_args (s2); if (f1 == NULL && f2 == NULL) return 1; /* Special case: No arguments. */ @@ -3107,6 +3110,8 @@ check_intents (gfc_formal_arglist *f, gfc_actual_a gfc_try gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) { + gfc_formal_arglist *dummy_args; + /* Warn about calls with an implicit interface. Special case for calling a ISO_C_BINDING becase c_loc and c_funloc are pseudo-unknown. Additionally, warn about procedures not @@ -3202,14 +3207,16 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arg return SUCCESS; } - if (!compare_actual_formal (ap, sym->formal, 0, sym->attr.elemental, where)) + dummy_args = gfc_sym_get_dummy_args (sym); + + if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, where)) return FAILURE; - if (check_intents (sym->formal, *ap) == FAILURE) + if (check_intents (dummy_args, *ap) == FAILURE) return FAILURE; if (gfc_option.warn_aliasing) - check_some_aliasing (sym->formal, *ap); + check_some_aliasing (dummy_args, *ap); return SUCCESS; } @@ -3222,7 +3229,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arg void gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where) { - /* Warn about calls with an implicit interface. Special case for calling a ISO_C_BINDING becase c_loc and c_funloc are pseudo-unknown. */ @@ -3250,12 +3256,13 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_argli return; } - if (!compare_actual_formal (ap, comp->formal, 0, comp->attr.elemental, where)) + if (!compare_actual_formal (ap, comp->ts.interface->formal, 0, + comp->attr.elemental, where)) return; - check_intents (comp->formal, *ap); + check_intents (comp->ts.interface->formal, *ap); if (gfc_option.warn_aliasing) - check_some_aliasing (comp->formal, *ap); + check_some_aliasing (comp->ts.interface->formal, *ap); } @@ -3266,16 +3273,19 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_argli bool gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym) { + gfc_formal_arglist *dummy_args; bool r; gcc_assert (sym->attr.flavor == FL_PROCEDURE); + dummy_args = gfc_sym_get_dummy_args (sym); + r = !sym->attr.elemental; - if (compare_actual_formal (args, sym->formal, r, !r, NULL)) + if (compare_actual_formal (args, dummy_args, r, !r, NULL)) { - check_intents (sym->formal, *args); + check_intents (dummy_args, *args); if (gfc_option.warn_aliasing) - check_some_aliasing (sym->formal, *args); + check_some_aliasing (dummy_args, *args); return true; } @@ -4080,8 +4090,9 @@ gfc_check_typebound_override (gfc_symtree* proc, g if (!old->n.tb->nopass && !old->n.tb->pass_arg) old_pass_arg = 1; argpos = 1; - for (proc_formal = proc_target->formal, old_formal = old_target->formal; - proc_formal && old_formal; + proc_formal = gfc_sym_get_dummy_args (proc_target); + old_formal = gfc_sym_get_dummy_args (old_target); + for ( ; proc_formal && old_formal; proc_formal = proc_formal->next, old_formal = old_formal->next) { if (proc->n.tb->pass_arg Index: gcc/fortran/module.c =================================================================== --- gcc/fortran/module.c (revision 195493) +++ gcc/fortran/module.c (working copy) @@ -2573,7 +2573,6 @@ mio_component (gfc_component *c, int vtype) { pointer_info *p; int n; - gfc_formal_arglist *formal; mio_lparen (); @@ -2606,33 +2605,8 @@ mio_component (gfc_component *c, int vtype) mio_expr (&c->initializer); if (c->attr.proc_pointer) - { - if (iomode == IO_OUTPUT) - { - formal = c->formal; - while (formal && !formal->sym) - formal = formal->next; + mio_typebound_proc (&c->tb); - if (formal) - mio_namespace_ref (&formal->sym->ns); - else - mio_namespace_ref (&c->formal_ns); - } - else - { - mio_namespace_ref (&c->formal_ns); - /* TODO: if (c->formal_ns) - { - c->formal_ns->proc_name = c; - c->refs++; - }*/ - } - - mio_formal_arglist (&c->formal); - - mio_typebound_proc (&c->tb); - } - mio_rparen (); } Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 195493) +++ gcc/fortran/resolve.c (working copy) @@ -223,7 +223,6 @@ resolve_procedure_interface (gfc_symbol *sym) sym->ts.interface = ifc; sym->attr.function = ifc->attr.function; sym->attr.subroutine = ifc->attr.subroutine; - gfc_copy_formal_args (sym, ifc, IFSRC_DECL); sym->attr.allocatable = ifc->attr.allocatable; sym->attr.pointer = ifc->attr.pointer; @@ -238,20 +237,10 @@ resolve_procedure_interface (gfc_symbol *sym) sym->attr.class_ok = ifc->attr.class_ok; /* Copy array spec. */ sym->as = gfc_copy_array_spec (ifc->as); - if (sym->as) - { - int i; - for (i = 0; i < sym->as->rank; i++) - { - gfc_expr_replace_symbols (sym->as->lower[i], sym); - gfc_expr_replace_symbols (sym->as->upper[i], sym); - } - } /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); - gfc_expr_replace_symbols (sym->ts.u.cl->length, sym); if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE) return FAILURE; @@ -3141,7 +3130,8 @@ resolve_function (gfc_expr *expr) if (expr->value.function.isym && expr->value.function.isym->inquiry) inquiry_argument = true; - no_formal_args = sym && is_external_proc (sym) && sym->formal == NULL; + no_formal_args = sym && is_external_proc (sym) + && gfc_sym_get_dummy_args (sym) == NULL; if (resolve_actual_arglist (expr->value.function.actual, p, no_formal_args) == FAILURE) @@ -3826,7 +3816,8 @@ resolve_call (gfc_code *c) if (csym) ptype = csym->attr.proc; - no_formal_args = csym && is_external_proc (csym) && csym->formal == NULL; + no_formal_args = csym && is_external_proc (csym) + && gfc_sym_get_dummy_args (csym) == NULL; if (resolve_actual_arglist (c->ext.actual, ptype, no_formal_args) == FAILURE) return FAILURE; @@ -6018,7 +6009,8 @@ resolve_typebound_generic_call (gfc_expr* e, const g->specific->pass_arg); } resolve_actual_arglist (args, target->attr.proc, - is_external_proc (target) && !target->formal); + is_external_proc (target) + && gfc_sym_get_dummy_args (target) == NULL); /* Check if this arglist matches the formal. */ matches = gfc_arglist_matches_symbol (&args, target); @@ -6438,7 +6430,7 @@ resolve_ppc_call (gfc_code* c) c->ext.actual = c->expr1->value.compcall.actual; if (resolve_actual_arglist (c->ext.actual, comp->attr.proc, - comp->formal == NULL) == FAILURE) + !(comp->ts.interface && comp->ts.interface->formal)) == FAILURE) return FAILURE; gfc_ppc_use (comp, &c->expr1->value.compcall.actual, &c->expr1->where); @@ -6472,7 +6464,7 @@ resolve_expr_ppc (gfc_expr* e) return FAILURE; if (resolve_actual_arglist (e->value.function.actual, comp->attr.proc, - comp->formal == NULL) == FAILURE) + !(comp->ts.interface && comp->ts.interface->formal)) == FAILURE) return FAILURE; if (update_ppc_arglist (e) == FAILURE) @@ -9963,6 +9955,7 @@ generate_component_assignments (gfc_code **code, g if (this_code->op == EXEC_ASSIGN_CALL) { + gfc_formal_arglist *dummy_args; gfc_symbol *rsym; /* Check that there is a typebound defined assignment. If not, then this must be a module defined assignment. We cannot @@ -9981,8 +9974,9 @@ generate_component_assignments (gfc_code **code, g /* If the first argument of the subroutine has intent INOUT a temporary must be generated and used instead. */ rsym = this_code->resolved_sym; - if (rsym->formal - && rsym->formal->sym->attr.intent == INTENT_INOUT) + dummy_args = gfc_sym_get_dummy_args (rsym); + if (dummy_args + && dummy_args->sym->attr.intent == INTENT_INOUT) { gfc_code *temp_code; inout = true; @@ -11414,7 +11408,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag { gfc_interface *iface; - for (arg = sym->formal; arg; arg = arg->next) + for (arg = gfc_sym_get_dummy_args (sym); arg; arg = arg->next) { if (arg->sym && arg->sym->ts.type == BT_DERIVED @@ -11436,7 +11430,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag PRIVATE to the containing module. */ for (iface = sym->generic; iface; iface = iface->next) { - for (arg = iface->sym->formal; arg; arg = arg->next) + for (arg = gfc_sym_get_dummy_args (iface->sym); arg; arg = arg->next) { if (arg->sym && arg->sym->ts.type == BT_DERIVED @@ -11460,7 +11454,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag PRIVATE to the containing module. */ for (iface = sym->generic; iface; iface = iface->next) { - for (arg = iface->sym->formal; arg; arg = arg->next) + for (arg = gfc_sym_get_dummy_args (iface->sym); arg; arg = arg->next) { if (arg->sym && arg->sym->ts.type == BT_DERIVED @@ -11580,7 +11574,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag sym->ts.is_c_interop = 1; } - curr_arg = sym->formal; + curr_arg = gfc_sym_get_dummy_args (sym); while (curr_arg != NULL) { /* Skip implicitly typed dummy args here. */ @@ -11667,6 +11661,7 @@ gfc_resolve_finalizers (gfc_symbol* derived) prev_link = &derived->f2k_derived->finalizers; for (list = derived->f2k_derived->finalizers; list; list = *prev_link) { + gfc_formal_arglist *dummy_args; gfc_symbol* arg; gfc_finalizer* i; int my_rank; @@ -11687,13 +11682,14 @@ gfc_resolve_finalizers (gfc_symbol* derived) } /* We should have exactly one argument. */ - if (!list->proc_sym->formal || list->proc_sym->formal->next) + dummy_args = gfc_sym_get_dummy_args (list->proc_sym); + if (!dummy_args || dummy_args->next) { gfc_error ("FINAL procedure at %L must have exactly one argument", &list->where); goto error; } - arg = list->proc_sym->formal->sym; + arg = dummy_args->sym; /* This argument must be of our type. */ if (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived) @@ -11745,11 +11741,14 @@ gfc_resolve_finalizers (gfc_symbol* derived) my_rank = (arg->as ? arg->as->rank : 0); for (i = list->next; i; i = i->next) { + gfc_formal_arglist *dummy_args; + /* Argument list might be empty; that is an error signalled earlier, but we nevertheless continued resolving. */ - if (i->proc_sym->formal) + dummy_args = gfc_sym_get_dummy_args (i->proc_sym); + if (dummy_args) { - gfc_symbol* i_arg = i->proc_sym->formal->sym; + gfc_symbol* i_arg = dummy_args->sym; const int i_rank = (i_arg->as ? i_arg->as->rank : 0); if (i_rank == my_rank) { @@ -11835,13 +11834,13 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, else if (t1->specific->pass_arg) pass1 = t1->specific->pass_arg; else - pass1 = t1->specific->u.specific->n.sym->formal->sym->name; + pass1 = gfc_sym_get_dummy_args (t1->specific->u.specific->n.sym)->sym->name; if (t2->specific->nopass) pass2 = NULL; else if (t2->specific->pass_arg) pass2 = t2->specific->pass_arg; else - pass2 = t2->specific->u.specific->n.sym->formal->sym->name; + pass2 = gfc_sym_get_dummy_args (t2->specific->u.specific->n.sym)->sym->name; if (gfc_compare_interfaces (sym1, sym2, sym2->name, !t1->is_operator, 0, NULL, 0, pass1, pass2)) { @@ -12205,16 +12204,19 @@ resolve_typebound_procedure (gfc_symtree* stree) from a .mod file. */ if (!stree->n.tb->nopass && stree->n.tb->pass_arg_num == 0) { + gfc_formal_arglist *dummy_args; + + dummy_args = gfc_sym_get_dummy_args (proc); if (stree->n.tb->pass_arg) { - gfc_formal_arglist* i; + gfc_formal_arglist *i; /* If an explicit passing argument name is given, walk the arg-list and look for it. */ me_arg = NULL; stree->n.tb->pass_arg_num = 1; - for (i = proc->formal; i; i = i->next) + for (i = dummy_args; i; i = i->next) { if (!strcmp (i->sym->name, stree->n.tb->pass_arg)) { @@ -12238,13 +12240,13 @@ resolve_typebound_procedure (gfc_symtree* stree) /* Otherwise, take the first one; there should in fact be at least one. */ stree->n.tb->pass_arg_num = 1; - if (!proc->formal) + if (!dummy_args) { gfc_error ("Procedure '%s' with PASS at %L must have at" " least one argument", proc->name, &where); goto error; } - me_arg = proc->formal->sym; + me_arg = dummy_args->sym; } /* Now check that the argument-type matches and the passed-object @@ -12623,30 +12625,18 @@ resolve_fl_derived0 (gfc_symbol *sym) c->ts.interface = ifc; c->attr.function = ifc->attr.function; c->attr.subroutine = ifc->attr.subroutine; - gfc_copy_formal_args_ppc (c, ifc, IFSRC_DECL); c->attr.pure = ifc->attr.pure; c->attr.elemental = ifc->attr.elemental; c->attr.recursive = ifc->attr.recursive; c->attr.always_explicit = ifc->attr.always_explicit; c->attr.ext_attr |= ifc->attr.ext_attr; - /* Replace symbols in array spec. */ - if (c->as) - { - int i; - for (i = 0; i < c->as->rank; i++) - { - gfc_expr_replace_comp (c->as->lower[i], c); - gfc_expr_replace_comp (c->as->upper[i], c); - } - } /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); - gfc_expr_replace_comp (cl->length, c); if (cl->length && !cl->resolved - && gfc_resolve_expr (cl->length) == FAILURE) + && gfc_resolve_expr (cl->length) == FAILURE) return FAILURE; c->ts.u.cl = cl; } @@ -12674,7 +12664,7 @@ resolve_fl_derived0 (gfc_symbol *sym) me_arg = NULL; c->tb->pass_arg_num = 1; - for (i = c->formal; i; i = i->next) + for (i = c->ts.interface->formal; i; i = i->next) { if (!strcmp (i->sym->name, c->tb->pass_arg)) { @@ -12698,7 +12688,7 @@ resolve_fl_derived0 (gfc_symbol *sym) /* Otherwise, take the first one; there should in fact be at least one. */ c->tb->pass_arg_num = 1; - if (!c->formal) + if (!c->ts.interface->formal) { gfc_error ("Procedure pointer component '%s' with PASS at %L " "must have at least one argument", @@ -12706,7 +12696,7 @@ resolve_fl_derived0 (gfc_symbol *sym) c->tb->error = 1; return FAILURE; } - me_arg = c->formal->sym; + me_arg = c->ts.interface->formal->sym; } /* Now check that the argument-type matches. */ @@ -14793,7 +14783,7 @@ check_uop_procedure (gfc_symbol *sym, locus where) return FAILURE; } - formal = sym->formal; + formal = gfc_sym_get_dummy_args (sym); if (!formal || !formal->sym) { gfc_error ("User operator procedure '%s' at %L must have at least " Index: gcc/fortran/symbol.c =================================================================== --- gcc/fortran/symbol.c (revision 195493) +++ gcc/fortran/symbol.c (working copy) @@ -2077,9 +2077,6 @@ free_components (gfc_component *p) gfc_free_array_spec (p->as); gfc_free_expr (p->initializer); - gfc_free_formal_arglist (p->formal); - gfc_free_namespace (p->formal_ns); - free (p); } } @@ -4127,64 +4124,6 @@ add_proc_interface (gfc_symbol *sym, ifsrc source, args based on the args of a given named interface. */ void -gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol *src, ifsrc if_src) -{ - gfc_formal_arglist *head = NULL; - gfc_formal_arglist *tail = NULL; - gfc_formal_arglist *formal_arg = NULL; - gfc_formal_arglist *curr_arg = NULL; - gfc_formal_arglist *formal_prev = NULL; - /* Save current namespace so we can change it for formal args. */ - gfc_namespace *parent_ns = gfc_current_ns; - - /* Create a new namespace, which will be the formal ns (namespace - of the formal args). */ - gfc_current_ns = gfc_get_namespace (parent_ns, 0); - gfc_current_ns->proc_name = dest; - dest->formal_ns = gfc_current_ns; - - for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next) - { - formal_arg = gfc_get_formal_arglist (); - gfc_get_symbol (curr_arg->sym->name, gfc_current_ns, &(formal_arg->sym)); - - /* May need to copy more info for the symbol. */ - formal_arg->sym->attr = curr_arg->sym->attr; - formal_arg->sym->ts = curr_arg->sym->ts; - formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as); - gfc_copy_formal_args (formal_arg->sym, curr_arg->sym, - curr_arg->sym->attr.if_source); - - /* If this isn't the first arg, set up the next ptr. For the - last arg built, the formal_arg->next will never get set to - anything other than NULL. */ - if (formal_prev != NULL) - formal_prev->next = formal_arg; - else - formal_arg->next = NULL; - - formal_prev = formal_arg; - - /* Add arg to list of formal args. */ - add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); - - /* Validate changes. */ - gfc_commit_symbol (formal_arg->sym); - } - - /* Add the interface to the symbol. */ - add_proc_interface (dest, if_src, head); - - /* Store the formal namespace information. */ - if (dest->formal != NULL) - /* The current ns should be that for the dest proc. */ - dest->formal_ns = gfc_current_ns; - /* Restore the current namespace to what it was on entry. */ - gfc_current_ns = parent_ns; -} - - -void gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src) { gfc_formal_arglist *head = NULL; @@ -4245,65 +4184,6 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_i } -void -gfc_copy_formal_args_ppc (gfc_component *dest, gfc_symbol *src, ifsrc if_src) -{ - gfc_formal_arglist *head = NULL; - gfc_formal_arglist *tail = NULL; - gfc_formal_arglist *formal_arg = NULL; - gfc_formal_arglist *curr_arg = NULL; - gfc_formal_arglist *formal_prev = NULL; - /* Save current namespace so we can change it for formal args. */ - gfc_namespace *parent_ns = gfc_current_ns; - - /* Create a new namespace, which will be the formal ns (namespace - of the formal args). */ - gfc_current_ns = gfc_get_namespace (parent_ns, 0); - /* TODO: gfc_current_ns->proc_name = dest;*/ - - for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next) - { - formal_arg = gfc_get_formal_arglist (); - gfc_get_symbol (curr_arg->sym->name, gfc_current_ns, &(formal_arg->sym)); - - /* May need to copy more info for the symbol. */ - formal_arg->sym->attr = curr_arg->sym->attr; - formal_arg->sym->ts = curr_arg->sym->ts; - formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as); - gfc_copy_formal_args (formal_arg->sym, curr_arg->sym, - curr_arg->sym->attr.if_source); - - /* If this isn't the first arg, set up the next ptr. For the - last arg built, the formal_arg->next will never get set to - anything other than NULL. */ - if (formal_prev != NULL) - formal_prev->next = formal_arg; - else - formal_arg->next = NULL; - - formal_prev = formal_arg; - - /* Add arg to list of formal args. */ - add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); - - /* Validate changes. */ - gfc_commit_symbol (formal_arg->sym); - } - - /* Add the interface to the symbol. */ - gfc_free_formal_arglist (dest->formal); - dest->formal = head; - dest->attr.if_source = if_src; - - /* Store the formal namespace information. */ - if (dest->formal != NULL) - /* The current ns should be that for the dest proc. */ - dest->formal_ns = gfc_current_ns; - /* Restore the current namespace to what it was on entry. */ - gfc_current_ns = parent_ns; -} - - /* Builds the parameter list for the iso_c_binding procedure c_f_pointer or c_f_procpointer. The old_sym typically refers to a generic version of either the c_f_pointer or c_f_procpointer @@ -4981,3 +4861,16 @@ gfc_find_dt_in_generic (gfc_symbol *sym) break; return intr ? intr->sym : NULL; } + + +gfc_formal_arglist * +gfc_sym_get_dummy_args (gfc_symbol *sym) +{ + gfc_formal_arglist *dummies; + + dummies = sym->formal; + if (dummies == NULL && sym->ts.interface != NULL) + dummies = sym->ts.interface->formal; + + return dummies; +} Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (revision 195493) +++ gcc/fortran/trans-array.c (working copy) @@ -6282,7 +6282,7 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) /* Map expressions involving the dummy arguments onto the actual argument expressions. */ gfc_init_interface_mapping (&mapping); - formal = expr->symtree->n.sym->formal; + formal = gfc_sym_get_dummy_args (expr->symtree->n.sym); arg = expr->value.function.actual; /* Set se = NULL in the calls to the interface mapping, to suppress any @@ -8626,7 +8626,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc tail = NULL; if (proc_ifc) - dummy_arg = proc_ifc->formal; + dummy_arg = gfc_sym_get_dummy_args (proc_ifc); else dummy_arg = NULL; Index: gcc/fortran/trans-decl.c =================================================================== --- gcc/fortran/trans-decl.c (revision 195493) +++ gcc/fortran/trans-decl.c (working copy) @@ -1906,7 +1906,7 @@ build_function_decl (gfc_symbol * sym, bool global { /* Look for alternate return placeholders. */ int has_alternate_returns = 0; - for (f = sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) { if (f->sym == NULL) { @@ -2074,11 +2074,11 @@ create_function_arglist (gfc_symbol * sym) } hidden_typelist = typelist; - for (f = sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) if (f->sym != NULL) /* Ignore alternate returns. */ hidden_typelist = TREE_CHAIN (hidden_typelist); - for (f = sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) { char name[GFC_MAX_SYMBOL_LEN + 2]; @@ -2344,7 +2344,8 @@ build_entry_thunks (gfc_namespace * ns, bool globa } } - for (formal = ns->proc_name->formal; formal; formal = formal->next) + for (formal = gfc_sym_get_dummy_args (ns->proc_name); formal; + formal = formal->next) { /* Ignore alternate returns. */ if (formal->sym == NULL) @@ -2352,7 +2353,7 @@ build_entry_thunks (gfc_namespace * ns, bool globa /* We don't have a clever way of identifying arguments, so resort to a brute-force search. */ - for (thunk_formal = thunk_sym->formal; + for (thunk_formal = gfc_sym_get_dummy_args (thunk_sym); thunk_formal; thunk_formal = thunk_formal->next) { @@ -2459,7 +2460,8 @@ build_entry_thunks (gfc_namespace * ns, bool globa /* We share the symbols in the formal argument list with other entry points and the master function. Clear them so that they are recreated for each function. */ - for (formal = thunk_sym->formal; formal; formal = formal->next) + for (formal = gfc_sym_get_dummy_args (thunk_sym); formal; + formal = formal->next) if (formal->sym != NULL) /* Ignore alternate returns. */ { formal->sym->backend_decl = NULL_TREE; @@ -3458,7 +3460,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wra tree present; gfc_init_block (&init); - for (f = proc_sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) if (f->sym && f->sym->attr.intent == INTENT_OUT && !f->sym->attr.pointer && f->sym->ts.type == BT_DERIVED) @@ -3911,7 +3913,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf gfc_init_block (&tmpblock); - for (f = proc_sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) { if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER) { @@ -4804,7 +4806,7 @@ add_argument_checking (stmtblock_t *block, gfc_sym { gfc_formal_arglist *formal; - for (formal = sym->formal; formal; formal = formal->next) + for (formal = gfc_sym_get_dummy_args (sym); formal; formal = formal->next) if (formal->sym && formal->sym->ts.type == BT_CHARACTER && !formal->sym->ts.deferred) { Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (revision 195493) +++ gcc/fortran/trans-expr.c (working copy) @@ -3266,7 +3266,7 @@ gfc_map_fcn_formal_to_actual (gfc_expr *expr, gfc_ gfc_actual_arglist *actual; actual = expr->value.function.actual; - f = map_expr->symtree->n.sym->formal; + f = gfc_sym_get_dummy_args (map_expr->symtree->n.sym); for (; f && actual; f = f->next, actual = actual->next) { @@ -3996,7 +3996,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * gfc_init_interface_mapping (&mapping); if (!comp) { - formal = sym->formal; + formal = gfc_sym_get_dummy_args (sym); need_interface_mapping = sym->attr.dimension || (sym->ts.type == BT_CHARACTER && sym->ts.u.cl->length @@ -4005,7 +4005,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * } else { - formal = comp->formal; + formal = comp->ts.interface ? comp->ts.interface->formal : NULL; need_interface_mapping = comp->attr.dimension || (comp->ts.type == BT_CHARACTER && comp->ts.u.cl->length @@ -4858,7 +4858,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * cl.backend_decl = (*stringargs)[0]; else { - formal = sym->ns->proc_name->formal; + formal = gfc_sym_get_dummy_args (sym->ns->proc_name); for (; formal; formal = formal->next) if (strcmp (formal->sym->name, sym->name) == 0) cl.backend_decl = formal->sym->ts.u.cl->backend_decl; @@ -5440,12 +5440,13 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr gfc_init_se (&rse, NULL); n = 0; - for (fargs = sym->formal; fargs; fargs = fargs->next) + for (fargs = gfc_sym_get_dummy_args (sym); fargs; fargs = fargs->next) n++; saved_vars = XCNEWVEC (gfc_saved_var, n); temp_vars = XCNEWVEC (tree, n); - for (fargs = sym->formal, n = 0; fargs; fargs = fargs->next, n++) + for (fargs = gfc_sym_get_dummy_args (sym), n = 0; fargs; + fargs = fargs->next, n++) { /* Each dummy shall be specified, explicitly or implicitly, to be scalar. */ @@ -5499,7 +5500,8 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr } /* Use the temporary variables in place of the real ones. */ - for (fargs = sym->formal, n = 0; fargs; fargs = fargs->next, n++) + for (fargs = gfc_sym_get_dummy_args (sym), n = 0; fargs; + fargs = fargs->next, n++) gfc_shadow_sym (fargs->sym, temp_vars[n], &saved_vars[n]); gfc_conv_expr (se, sym->value); @@ -5525,7 +5527,8 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr } /* Restore the original variables. */ - for (fargs = sym->formal, n = 0; fargs; fargs = fargs->next, n++) + for (fargs = gfc_sym_get_dummy_args (sym), n = 0; fargs; + fargs = fargs->next, n++) gfc_restore_sym (fargs->sym, &saved_vars[n]); free (temp_vars); free (saved_vars); Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (revision 195493) +++ gcc/fortran/trans-stmt.c (working copy) @@ -236,7 +236,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_ ss = loopse->ss; arg0 = arg; - formal = sym->formal; + formal = gfc_sym_get_dummy_args (sym); /* Loop over all the arguments testing for dependencies. */ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL) Index: gcc/fortran/trans-types.c =================================================================== --- gcc/fortran/trans-types.c (revision 195493) +++ gcc/fortran/trans-types.c (working copy) @@ -2679,7 +2679,7 @@ create_fn_spec (gfc_symbol *sym, tree fntype) spec[spec_len++] = 'R'; } - for (f = sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) if (spec_len < sizeof (spec)) { if (!f->sym || f->sym->attr.pointer || f->sym->attr.target @@ -2763,7 +2763,7 @@ gfc_get_function_type (gfc_symbol * sym) } /* Build the argument types for the function. */ - for (f = sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) { arg = f->sym; if (arg) @@ -2806,7 +2806,7 @@ gfc_get_function_type (gfc_symbol * sym) } /* Add hidden string length parameters. */ - for (f = sym->formal; f; f = f->next) + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) { arg = f->sym; if (arg && arg->ts.type == BT_CHARACTER && !sym->attr.is_bind_c)