@@ -1135,6 +1135,9 @@ gfc_component;
/* dummy arg of either an intrinsic or a user-defined procedure. */
class gfc_dummy_arg
{
+public:
+ virtual const gfc_typespec & get_typespec () const = 0;
+ virtual bool is_optional () const = 0;
};
@@ -1145,6 +1148,9 @@ struct gfc_formal_arglist : public gfc_dummy_arg
struct gfc_symbol *sym;
/* Points to the next formal argument. */
struct gfc_formal_arglist *next;
+
+ virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE;
+ virtual bool is_optional () const FINAL OVERRIDE;
};
#define GFC_NEW(T) new (XCNEW (T)) T
@@ -2181,6 +2187,9 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg
ENUM_BITFIELD (sym_intent) intent:2;
struct gfc_intrinsic_arg *next;
+
+ virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE;
+ virtual bool is_optional () const FINAL OVERRIDE;
};
#define gfc_get_intrinsic_arg() GFC_NEW (gfc_intrinsic_arg)
@@ -5507,3 +5507,16 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
" only be called via an explicit interface or if declared"
" EXTERNAL.", sym->name, &sym->declared_at);
}
+
+
+const gfc_typespec &
+gfc_intrinsic_arg::get_typespec () const
+{
+ return ts;
+}
+
+bool
+gfc_intrinsic_arg::is_optional () const
+{
+ return optional;
+}
@@ -5259,3 +5259,16 @@ gfc_sym_get_dummy_args (gfc_symbol *sym)
return dummies;
}
+
+
+const gfc_typespec &
+gfc_formal_arglist::get_typespec () const
+{
+ return sym->ts;
+}
+
+bool
+gfc_formal_arglist::is_optional () const
+{
+ return sym->attr.optional;
+}
@@ -2879,7 +2879,7 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
/* If the expression is of polymorphic type, it's actual size is not known,
so we avoid copying it anywhere. */
if (ss_info->data.scalar.dummy_arg
- && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS
+ && ss_info->data.scalar.dummy_arg->get_typespec ().type == BT_CLASS
&& ss_info->expr->ts.type == BT_CLASS)
return true;
@@ -11207,9 +11207,8 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref)
gfc_ss *
gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
- gfc_symbol *proc_ifc, gfc_ss_type type)
+ gfc_ss_type type)
{
- gfc_formal_arglist *dummy_arg;
int scalar;
gfc_ss *head;
gfc_ss *tail;
@@ -11218,16 +11217,12 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
head = gfc_ss_terminator;
tail = NULL;
- if (proc_ifc)
- dummy_arg = gfc_sym_get_dummy_args (proc_ifc);
- else
- dummy_arg = NULL;
-
scalar = 1;
for (; arg; arg = arg->next)
{
+ gfc_dummy_arg * const dummy_arg = arg->associated_dummy;
if (!arg->expr || arg->expr->expr_type == EXPR_NULL)
- goto loop_continue;
+ continue;
newss = gfc_walk_subexpr (head, arg->expr);
if (newss == head)
@@ -11237,13 +11232,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
newss = gfc_get_scalar_ss (head, arg->expr);
newss->info->type = type;
if (dummy_arg)
- newss->info->data.scalar.dummy_arg = dummy_arg->sym;
+ newss->info->data.scalar.dummy_arg = dummy_arg;
}
else
scalar = 0;
if (dummy_arg != NULL
- && dummy_arg->sym->attr.optional
+ && dummy_arg->is_optional ()
&& arg->expr->expr_type == EXPR_VARIABLE
&& (gfc_expr_attr (arg->expr).optional
|| gfc_expr_attr (arg->expr).allocatable
@@ -11257,10 +11252,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
while (tail->next != gfc_ss_terminator)
tail = tail->next;
}
-
-loop_continue:
- if (dummy_arg != NULL)
- dummy_arg = dummy_arg->next;
}
if (scalar)
@@ -11319,7 +11310,6 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
ss = gfc_walk_elemental_function_args (old_ss,
expr->value.function.actual,
- gfc_get_proc_ifc_for_expr (expr),
GFC_SS_REFERENCE);
if (ss != old_ss
&& (comp
@@ -82,7 +82,7 @@ gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref);
/* Walk the arguments of an elemental function. */
gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *,
- gfc_symbol *, gfc_ss_type);
+ gfc_ss_type);
/* Walk an intrinsic function. */
gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
gfc_intrinsic_sym *);
@@ -11163,7 +11163,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
if (isym->elemental)
return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
- NULL, GFC_SS_SCALAR);
+ GFC_SS_SCALAR);
if (expr->rank == 0)
return ss;
@@ -356,27 +356,6 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
}
-/* Get the interface symbol for the procedure corresponding to the given call.
- We can't get the procedure symbol directly as we have to handle the case
- of (deferred) type-bound procedures. */
-
-static gfc_symbol *
-get_proc_ifc_for_call (gfc_code *c)
-{
- gfc_symbol *sym;
-
- gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL);
-
- sym = gfc_get_proc_ifc_for_expr (c->expr1);
-
- /* Fall back/last resort try. */
- if (sym == NULL)
- sym = c->resolved_sym;
-
- return sym;
-}
-
-
/* Translate the CALL statement. Builds a call to an F95 subroutine. */
tree
@@ -402,7 +381,6 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
ss = gfc_ss_terminator;
if (code->resolved_sym->attr.elemental)
ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
- get_proc_ifc_for_call (code),
GFC_SS_REFERENCE);
/* MVBITS is inlined but needs the dependency checking found here. */
@@ -266,8 +266,8 @@ typedef struct gfc_ss_info
struct
{
/* If the scalar is passed as actual argument to an (elemental) procedure,
- this is the symbol of the corresponding dummy argument. */
- gfc_symbol *dummy_arg;
+ this is the corresponding dummy argument. */
+ gfc_dummy_arg *dummy_arg;
tree value;
/* Tells that the scalar is a reference to a variable that might
be present on the lhs, so that we should evaluate the value