/* Perform type resolution on the various structures.
- Copyright (C) 2001-2019 Free Software Foundation, Inc.
+ Copyright (C) 2001-2020 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
Since a dummy argument cannot be a non-dummy procedure, the only
resort left for untyped names are the IMPLICIT types. */
-static void
-resolve_formal_arglist (gfc_symbol *proc)
+void
+gfc_resolve_formal_arglist (gfc_symbol *proc)
{
gfc_formal_arglist *f;
gfc_symbol *sym;
}
if (sym->attr.if_source != IFSRC_UNKNOWN)
- resolve_formal_arglist (sym);
+ gfc_resolve_formal_arglist (sym);
if (sym->attr.subroutine || sym->attr.external)
{
|| gfc_fl_struct (sym->attr.flavor) || sym->attr.intrinsic)
return;
- resolve_formal_arglist (sym);
+ gfc_resolve_formal_arglist (sym);
}
gfc_intrinsic_sym* isym = NULL;
const char* symstd;
- if (sym->formal)
+ if (sym->resolve_symbol_called >= 2)
return true;
+ sym->resolve_symbol_called = 2;
+
/* Already resolved. */
if (sym->from_intmod && sym->ts.type != BT_UNKNOWN)
return true;
&& (set_by_optional || arg->expr->rank != rank)
&& !(isym && isym->id == GFC_ISYM_CONVERSION))
{
- gfc_warning (OPT_Wpedantic,
- "%qs at %L is an array and OPTIONAL; IF IT IS "
- "MISSING, it cannot be the actual argument of an "
- "ELEMENTAL procedure unless there is a non-optional "
- "argument with the same rank (12.4.1.5)",
- arg->expr->symtree->n.sym->name, &arg->expr->where);
+ bool t = false;
+ gfc_actual_arglist *a;
+
+ /* Scan the argument list for a non-optional argument with the
+ same rank as arg. */
+ for (a = arg0; a; a = a->next)
+ if (a != arg
+ && a->expr->rank == arg->expr->rank
+ && !a->expr->symtree->n.sym->attr.optional)
+ {
+ t = true;
+ break;
+ }
+
+ if (!t)
+ gfc_warning (OPT_Wpedantic,
+ "%qs at %L is an array and OPTIONAL; If it is not "
+ "present, then it cannot be the actual argument of "
+ "an ELEMENTAL procedure unless there is a non-optional"
+ " argument with the same rank "
+ "(Fortran 2018, 15.5.2.12)",
+ arg->expr->symtree->n.sym->name, &arg->expr->where);
}
}
/* Elemental procedure's array actual arguments must conform. */
if (e != NULL)
{
- if (!gfc_check_conformance (arg->expr, e, "elemental procedure"))
+ if (!gfc_check_conformance (arg->expr, e, _("elemental procedure")))
return false;
}
else
goto done;
}
- if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU))
- /* Turn erros into warnings with -std=gnu and -std=legacy. */
- gfc_errors_to_warnings (true);
-
+ bool bad_result_characteristics;
if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
- reason, sizeof(reason), NULL, NULL))
+ reason, sizeof(reason), NULL, NULL,
+ &bad_result_characteristics))
{
- gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:"
- " %s", sym->name, &sym->declared_at, reason);
+ /* Turn erros into warnings with -std=gnu and -std=legacy,
+ unless a function returns a wrong type, which can lead
+ to all kinds of ICEs and wrong code. */
+
+ if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU)
+ && !bad_result_characteristics)
+ gfc_errors_to_warnings (true);
+
+ gfc_error ("Interface mismatch in global procedure %qs at %L: %s",
+ sym->name, &sym->declared_at, reason);
+ sym->error = 1;
+ gfc_errors_to_warnings (false);
goto done;
}
}
done:
- gfc_errors_to_warnings (false);
if (gsym->type == GSYM_UNKNOWN)
{
|| sym->intmod_sym_id == GFC_ISYM_CAF_SEND))
return true;
+ if (expr->ref)
+ {
+ gfc_error ("Unexpected junk after %qs at %L", expr->symtree->n.sym->name,
+ &expr->where);
+ return false;
+ }
+
if (sym && sym->attr.intrinsic
&& !gfc_resolve_intrinsic (sym, &expr->where))
return false;
return 0;
}
+/* Return true if TYPE is character based, false otherwise. */
+
+static int
+is_character_based (bt type)
+{
+ return type == BT_CHARACTER || type == BT_HOLLERITH;
+}
+
+
+/* If expression is a hollerith, convert it to character and issue a warning
+ for the conversion. */
+
+static void
+convert_hollerith_to_character (gfc_expr *e)
+{
+ if (e->ts.type == BT_HOLLERITH)
+ {
+ gfc_typespec t;
+ gfc_clear_ts (&t);
+ t.type = BT_CHARACTER;
+ t.kind = e->ts.kind;
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
+
+/* Convert to numeric and issue a warning for the conversion. */
+
+static void
+convert_to_numeric (gfc_expr *a, gfc_expr *b)
+{
+ gfc_typespec t;
+ gfc_clear_ts (&t);
+ t.type = b->ts.type;
+ t.kind = b->ts.kind;
+ gfc_convert_type_warn (a, &t, 2, 1);
+}
/* Resolve an operator expression node. This can involve replacing the
operation with a user defined function call. */
op1 = e->value.op.op1;
op2 = e->value.op.op2;
+ if (op1 == NULL && op2 == NULL)
+ return false;
+
dual_locus_error = false;
/* op1 and op2 cannot both be BOZ. */
case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
+
+ if (flag_dec
+ && is_character_based (op1->ts.type)
+ && is_character_based (op2->ts.type))
+ {
+ convert_hollerith_to_character (op1);
+ convert_hollerith_to_character (op2);
+ }
+
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
&& op1->ts.kind == op2->ts.kind)
{
/* If op1 is BOZ, then op2 is not!. Try to convert to type of op2. */
if (op1->ts.type == BT_BOZ)
{
- if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
- "an operand of a relational operator",
- &op1->where))
+ if (gfc_invalid_boz (G_("BOZ literal constant near %L cannot appear "
+ "as an operand of a relational operator"),
+ &op1->where))
return false;
if (op2->ts.type == BT_INTEGER && !gfc_boz2int (op1, op2->ts.kind))
/* If op2 is BOZ, then op1 is not!. Try to convert to type of op2. */
if (op2->ts.type == BT_BOZ)
{
- if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
- "an operand of a relational operator",
+ if (gfc_invalid_boz (G_("BOZ literal constant near %L cannot appear"
+ " as an operand of a relational operator"),
&op2->where))
return false;
if (op1->ts.type == BT_REAL && !gfc_boz2real (op2, op1->ts.kind))
return false;
}
+ if (flag_dec
+ && op1->ts.type == BT_HOLLERITH && gfc_numeric_ts (&op2->ts))
+ convert_to_numeric (op1, op2);
+
+ if (flag_dec
+ && gfc_numeric_ts (&op1->ts) && op2->ts.type == BT_HOLLERITH)
+ convert_to_numeric (op2, op1);
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
const char *msg;
if (op == INTRINSIC_EQ || op == INTRINSIC_EQ_OS)
- msg = "Equality comparison for %s at %L";
+ msg = G_("Equality comparison for %s at %L");
else
- msg = "Inequality comparison for %s at %L";
+ msg = G_("Inequality comparison for %s at %L");
gfc_warning (OPT_Wcompare_reals, msg,
gfc_typename (op1), &op1->where);
return;
}
- e->ts.type = BT_CHARACTER;
- e->ts.kind = gfc_default_character_kind;
-
if (!e->ts.u.cl)
e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
/* Resolve subtype references. */
-static bool
-resolve_ref (gfc_expr *expr)
+bool
+gfc_resolve_ref (gfc_expr *expr)
{
- int current_part_dimension, n_components, seen_part_dimension;
- gfc_ref *ref, **prev;
+ int current_part_dimension, n_components, seen_part_dimension, dim;
+ gfc_ref *ref, **prev, *array_ref;
bool equal_length;
for (ref = expr->ref; ref; ref = ref->next)
current_part_dimension = 0;
seen_part_dimension = 0;
n_components = 0;
+ array_ref = NULL;
for (ref = expr->ref; ref; ref = ref->next)
{
switch (ref->type)
{
case REF_ARRAY:
+ array_ref = ref;
switch (ref->u.ar.type)
{
case AR_FULL:
break;
case AR_ELEMENT:
+ array_ref = NULL;
current_part_dimension = 0;
break;
break;
case REF_SUBSTRING:
+ break;
+
case REF_INQUIRY:
+ /* Implement requirement in note 9.7 of F2018 that the result of the
+ LEN inquiry be a scalar. */
+ if (ref->u.i == INQUIRY_LEN && array_ref && expr->ts.deferred)
+ {
+ array_ref->u.ar.type = AR_ELEMENT;
+ expr->rank = 0;
+ /* INQUIRY_LEN is not evaluated from the rest of the expr
+ but directly from the string length. This means that setting
+ the array indices to one does not matter but might trigger
+ a runtime bounds error. Suppress the check. */
+ expr->no_bounds_check = 1;
+ for (dim = 0; dim < array_ref->u.ar.dimen; dim++)
+ {
+ array_ref->u.ar.dimen_type[dim] = DIMEN_ELEMENT;
+ if (array_ref->u.ar.start[dim])
+ gfc_free_expr (array_ref->u.ar.start[dim]);
+ array_ref->u.ar.start[dim]
+ = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ if (array_ref->u.ar.end[dim])
+ gfc_free_expr (array_ref->u.ar.end[dim]);
+ if (array_ref->u.ar.stride[dim])
+ gfc_free_expr (array_ref->u.ar.stride[dim]);
+ }
+ }
break;
}
examining the base symbol and any reference structures it may have. */
void
-expression_rank (gfc_expr *e)
+gfc_expression_rank (gfc_expr *e)
{
gfc_ref *ref;
int i, rank;
goto done;
/* Constructors can have a rank different from one via RESHAPE(). */
- if (e->symtree == NULL)
- {
- e->rank = 0;
- goto done;
- }
-
- e->rank = (e->symtree->n.sym->as == NULL)
- ? 0 : e->symtree->n.sym->as->rank;
+ e->rank = ((e->symtree == NULL || e->symtree->n.sym->as == NULL)
+ ? 0 : e->symtree->n.sym->as->rank);
goto done;
}
{
/* Figure out the rank of the section. */
if (rank != 0)
- gfc_internal_error ("expression_rank(): Two array specs");
+ gfc_internal_error ("gfc_expression_rank(): Two array specs");
for (i = 0; i < ref->u.ar.dimen; i++)
if (ref->u.ar.dimen_type[i] == DIMEN_RANGE
}
}
- if (e->ref && !resolve_ref (e))
+ if (e->ref && !gfc_resolve_ref (e))
return false;
if (sym->attr.flavor == FL_PROCEDURE
}
if (t)
- expression_rank (e);
+ gfc_expression_rank (e);
if (t && flag_coarray == GFC_FCOARRAY_LIB && gfc_is_coindexed (e))
add_caf_get_intrinsic (e);
if (st == NULL)
return resolve_compcall (e, NULL);
- if (!resolve_ref (e))
+ if (!gfc_resolve_ref (e))
return false;
/* Get the CLASS declared type. */
if (st == NULL)
return resolve_typebound_call (code, NULL, NULL);
- if (!resolve_ref (code->expr1))
+ if (!gfc_resolve_ref (code->expr1))
return false;
/* Get the CLASS declared type. */
if (!comp->attr.subroutine)
gfc_add_subroutine (&comp->attr, comp->name, &c->expr1->where);
- if (!resolve_ref (c->expr1))
+ if (!gfc_resolve_ref (c->expr1))
return false;
if (!update_ppc_arglist (c->expr1))
if (!comp->attr.function)
gfc_add_function (&comp->attr, comp->name, &e->where);
- if (!resolve_ref (e))
+ if (!gfc_resolve_ref (e))
return false;
if (!resolve_actual_arglist (e->value.function.actual, comp->attr.proc,
break;
case EXPR_SUBSTRING:
- t = resolve_ref (e);
+ t = gfc_resolve_ref (e);
break;
case EXPR_CONSTANT:
case EXPR_ARRAY:
t = false;
- if (!resolve_ref (e))
+ if (!gfc_resolve_ref (e))
break;
t = gfc_resolve_array_constructor (e);
/* Also try to expand a constructor. */
if (t)
{
- expression_rank (e);
+ gfc_expression_rank (e);
if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e))
gfc_expand_constructor (e, false);
}
break;
case EXPR_STRUCTURE:
- t = resolve_ref (e);
+ t = gfc_resolve_ref (e);
if (!t)
break;
/* For variable targets, we get some attributes from the target. */
if (target->expr_type == EXPR_VARIABLE)
{
- gfc_symbol* tsym;
+ gfc_symbol *tsym, *dsym;
gcc_assert (target->symtree);
tsym = target->symtree->n.sym;
+ if (gfc_expr_attr (target).proc_pointer)
+ {
+ gfc_error ("Associating entity %qs at %L is a procedure pointer",
+ tsym->name, &target->where);
+ return;
+ }
+
+ if (tsym->attr.flavor == FL_PROCEDURE && tsym->generic
+ && (dsym = gfc_find_dt_in_generic (tsym)) != NULL
+ && dsym->attr.flavor == FL_DERIVED)
+ {
+ gfc_error ("Derived type %qs cannot be used as a variable at %L",
+ tsym->name, &target->where);
+ return;
+ }
+
+ if (tsym->attr.flavor == FL_PROCEDURE)
+ {
+ bool is_error = true;
+ if (tsym->attr.function && tsym->result == tsym)
+ for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent)
+ if (tsym == ns->proc_name)
+ {
+ is_error = false;
+ break;
+ }
+ if (is_error)
+ {
+ gfc_error ("Associating entity %qs at %L is a procedure name",
+ tsym->name, &target->where);
+ return;
+ }
+ }
+
sym->attr.asynchronous = tsym->attr.asynchronous;
sym->attr.volatile_ = tsym->attr.volatile_;
if (is_subref_array (target))
sym->attr.subref_array_pointer = 1;
}
+ else if (target->ts.type == BT_PROCEDURE)
+ {
+ gfc_error ("Associating selector-expression at %L yields a procedure",
+ &target->where);
+ return;
+ }
if (target->expr_type == EXPR_NULL)
{
as = NULL;
sym->ts = *ts;
sym->ts.type = BT_CLASS;
- attr = CLASS_DATA (sym)->attr;
+ attr = CLASS_DATA (sym) ? CLASS_DATA (sym)->attr : sym->attr;
attr.class_ok = 0;
attr.associate_var = 1;
attr.dimension = attr.codimension = 0;
{
if (code->expr1->symtree->n.sym->attr.untyped)
code->expr1->symtree->n.sym->ts = code->expr2->ts;
- selector_type = CLASS_DATA (code->expr2)->ts.u.derived;
+ selector_type = CLASS_DATA (code->expr2)
+ ? CLASS_DATA (code->expr2)->ts.u.derived : code->expr2->ts.u.derived;
}
if (code->expr2->rank && CLASS_DATA (code->expr1)->as)
gfc_namespace *ns;
gfc_code *body, *new_st, *tail;
gfc_case *c;
- char tname[GFC_MAX_SYMBOL_LEN];
+ char tname[GFC_MAX_SYMBOL_LEN + 7];
char name[2 * GFC_MAX_SYMBOL_LEN];
gfc_symtree *st;
gfc_expr *selector_expr = NULL;
"an assumed-size array", &code->loc);
return;
}
-
- if (async_io_dt && exp->expr_type == EXPR_VARIABLE)
- exp->symtree->n.sym->attr.asynchronous = 1;
}
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
case EXEC_OACC_KERNELS:
+ case EXEC_OACC_SERIAL_LOOP:
+ case EXEC_OACC_SERIAL:
case EXEC_OACC_DATA:
case EXEC_OACC_HOST_DATA:
case EXEC_OACC_LOOP:
lhs = code->expr1;
rhs = code->expr2;
+ if ((gfc_numeric_ts (&lhs->ts) || lhs->ts.type == BT_LOGICAL)
+ && rhs->ts.type == BT_CHARACTER
+ && (rhs->expr_type != EXPR_CONSTANT || !flag_dec_char_conversions))
+ {
+ /* Use of -fdec-char-conversions allows assignment of character data
+ to non-character variables. This not permited for nonconstant
+ strings. */
+ gfc_error ("Cannot convert %s to %s at %L", gfc_typename (rhs),
+ gfc_typename (lhs), &rhs->where);
+ return false;
+ }
+
/* Handle the case of a BOZ literal on the RHS. */
if (rhs->ts.type == BT_BOZ)
{
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
case EXEC_OACC_KERNELS:
+ case EXEC_OACC_SERIAL_LOOP:
+ case EXEC_OACC_SERIAL:
case EXEC_OACC_DATA:
case EXEC_OACC_HOST_DATA:
case EXEC_OACC_LOOP:
case EXEC_GOTO:
if (code->expr1 != NULL)
{
- if (code->expr1->ts.type != BT_INTEGER)
- gfc_error ("ASSIGNED GOTO statement at %L requires an "
- "INTEGER variable", &code->expr1->where);
- else if (code->expr1->symtree->n.sym->attr.assign != 1)
+ if (code->expr1->expr_type != EXPR_VARIABLE
+ || code->expr1->ts.type != BT_INTEGER
+ || (code->expr1->ref
+ && code->expr1->ref->type == REF_ARRAY)
+ || code->expr1->symtree == NULL
+ || (code->expr1->symtree->n.sym
+ && (code->expr1->symtree->n.sym->attr.flavor
+ == FL_PARAMETER)))
+ gfc_error ("ASSIGNED GOTO statement at %L requires a "
+ "scalar INTEGER variable", &code->expr1->where);
+ else if (code->expr1->symtree->n.sym
+ && code->expr1->symtree->n.sym->attr.assign != 1)
gfc_error ("Variable %qs has not been assigned a target "
"label at %L", code->expr1->symtree->n.sym->name,
&code->expr1->where);
|| code->expr1->symtree->n.sym->ts.type != BT_INTEGER
|| code->expr1->symtree->n.sym->ts.kind
!= gfc_default_integer_kind
+ || code->expr1->symtree->n.sym->attr.flavor == FL_PARAMETER
|| code->expr1->symtree->n.sym->as != NULL))
gfc_error ("ASSIGN statement at %L requires a scalar "
"default INTEGER variable", &code->expr1->where);
break;
case EXEC_OPEN:
- if (!gfc_resolve_open (code->ext.open))
+ if (!gfc_resolve_open (code->ext.open, &code->loc))
break;
resolve_branch (code->ext.open->err, code);
break;
case EXEC_CLOSE:
- if (!gfc_resolve_close (code->ext.close))
+ if (!gfc_resolve_close (code->ext.close, &code->loc))
break;
resolve_branch (code->ext.close->err, code);
case EXEC_READ:
case EXEC_WRITE:
- if (!gfc_resolve_dt (code->ext.dt, &code->loc))
+ if (!gfc_resolve_dt (code, code->ext.dt, &code->loc))
break;
resolve_branch (code->ext.dt->err, code);
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
case EXEC_OACC_KERNELS:
+ case EXEC_OACC_SERIAL_LOOP:
+ case EXEC_OACC_SERIAL:
case EXEC_OACC_DATA:
case EXEC_OACC_HOST_DATA:
case EXEC_OACC_LOOP:
}
/* cl->length has been resolved. It should have an integer type. */
- if (cl->length->ts.type != BT_INTEGER)
+ if (cl->length->ts.type != BT_INTEGER || cl->length->rank != 0)
{
gfc_error ("Scalar INTEGER expression expected at %L",
&cl->length->where);
{
gfc_error ("Array pointer %qs at %L must have a deferred shape or "
"assumed rank", sym->name, &sym->declared_at);
+ sym->error = 1;
return false;
}
}
{
if (arg->sym
&& arg->sym->ts.type == BT_DERIVED
+ && arg->sym->ts.u.derived
&& !arg->sym->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (arg->sym->ts.u.derived)
&& !gfc_notify_std (GFC_STD_F2003, "%qs is of a PRIVATE type "
{
if (sym->attr.proc_pointer)
{
+ const char* name = (sym->attr.result ? sym->ns->proc_name->name
+ : sym->name);
gfc_error ("Procedure pointer %qs at %L shall not be elemental",
- sym->name, &sym->declared_at);
+ name, &sym->declared_at);
return false;
}
if (sym->attr.dummy)
if (sym->attr.subroutine && sym->attr.result)
{
gfc_error ("PROCEDURE attribute conflicts with RESULT attribute "
- "in %qs at %L", sym->name, &sym->declared_at);
+ "in %qs at %L", sym->ns->proc_name->name, &sym->declared_at);
return false;
}
if (sym->attr.external && sym->attr.function && !sym->attr.module_procedure
{
/* If proc has not been resolved at this point, proc->name may
actually be a USE associated entity. See PR fortran/89647. */
- if (!proc->resolved
+ if (!proc->resolve_symbol_called
&& proc->attr.function == 0 && proc->attr.subroutine == 0)
{
gfc_symbol *tmp;
}
}
- if (async_io_dt)
- {
- for (nl = sym->namelist; nl; nl = nl->next)
- nl->sym->attr.asynchronous = 1;
- }
return true;
}
gfc_array_spec *as;
bool saved_specification_expr;
- if (sym->resolved)
+ if (sym->resolve_symbol_called >= 1)
return;
- sym->resolved = 1;
+ sym->resolve_symbol_called = 1;
/* No symbol will ever have union type; only components can be unions.
Union type declaration symbols have type BT_UNKNOWN but flavor FL_UNION
if (flag_coarray == GFC_FCOARRAY_LIB && sym->ts.type == BT_CLASS
&& sym->ts.u.derived && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.codimension
+ && CLASS_DATA (sym)->ts.u.derived
&& (CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp
|| CLASS_DATA (sym)->ts.u.derived->attr.pointer_comp))
{
if (formal)
{
sym->formal_ns = formal->sym->ns;
- if (sym->ns != formal->sym->ns)
+ if (sym->formal_ns && sym->ns != formal->sym->ns)
sym->formal_ns->refs++;
}
}
&& !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))
continue;
- identical_types:
+identical_types:
+
last_ts =&sym->ts;
last_where = &e->where;
continue;
/* Shall not be an automatic array. */
- if (e->ref->type == REF_ARRAY
- && !gfc_resolve_array_spec (e->ref->u.ar.as, 1))
+ if (e->ref->type == REF_ARRAY && is_non_constant_shape_array (sym))
{
gfc_error ("Array %qs at %L with non-constant bounds cannot be "
"an EQUIVALENCE object", sym->name, &e->where);
}
-/* Function called by resolve_fntype to flag other symbol used in the
- length type parameter specification of function resuls. */
+/* Function called by resolve_fntype to flag other symbols used in the
+ length type parameter specification of function results. */
static bool
flag_fn_result_spec (gfc_expr *expr,
gfc_data *d;
gfc_equiv *eq;
gfc_namespace* old_ns = gfc_current_ns;
+ bool recursive = ns->proc_name && ns->proc_name->attr.recursive;
if (ns->types_resolved)
return;
if (ns->proc_name && ns->proc_name->attr.flavor == FL_PROCEDURE
&& ns->proc_name->attr.if_source == IFSRC_IFBODY)
- resolve_formal_arglist (ns->proc_name);
+ gfc_resolve_formal_arglist (ns->proc_name);
gfc_traverse_ns (ns, resolve_bind_c_derived_types);
gfc_traverse_ns (ns, resolve_values);
- if (ns->save_all || !flag_automatic)
+ if (ns->save_all || (!flag_automatic && !recursive))
gfc_save_all (ns);
iter_stack = NULL;
projects / gcc.git / blobdiff