This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
Attachment:
call_interface-1.CL
Description: Text document
diff --git a/trans-array.c b/trans-array.c index d3c81a8..2584e78 100644 --- a/trans-array.c +++ b/trans-array.c @@ -8427,6 +8427,36 @@ gfc_reverse_ss (gfc_ss * ss) } +/* Given an expression refering to a procedure, return the symbol of its + interface. We can't get the procedure symbol directly as we have to handle + the case of (deferred) type-bound procedures. */ + +gfc_symbol * +gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref) +{ + gfc_symbol *sym; + gfc_ref *ref; + + if (procedure_ref == NULL) + return NULL; + + /* Normal procedure case. */ + sym = procedure_ref->symtree->n.sym; + + /* Typebound procedure case. */ + for (ref = procedure_ref->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT + && ref->u.c.component->attr.proc_pointer) + sym = ref->u.c.component->ts.interface; + else + sym = NULL; + } + + return sym; +} + + /* Walk the arguments of an elemental function. PROC_EXPR is used to check whether an argument is permitted to be absent. If it is NULL, we don't do the check and the argument is assumed to be present. @@ -8436,6 +8466,7 @@ gfc_ss * gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, gfc_expr *proc_expr, gfc_ss_type type) { + gfc_symbol *proc_ifc; gfc_formal_arglist *dummy_arg; int scalar; gfc_ss *head; @@ -8445,24 +8476,9 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = NULL; - if (proc_expr) - { - gfc_ref *ref; - - /* Normal procedure case. */ - dummy_arg = proc_expr->symtree->n.sym->formal; - - /* Typebound procedure case. */ - for (ref = proc_expr->ref; ref; ref = ref->next) - { - if (ref->type == REF_COMPONENT - && ref->u.c.component->attr.proc_pointer - && ref->u.c.component->ts.interface) - dummy_arg = ref->u.c.component->ts.interface->formal; - else - dummy_arg = NULL; - } - } + proc_ifc = gfc_get_proc_ifc_for_expr (proc_expr); + if (proc_ifc) + dummy_arg = proc_ifc->formal; else dummy_arg = NULL;
Attachment:
call_interface-2.CL
Description: Text document
diff --git a/trans-array.c b/trans-array.c index 2584e78..de6fa13 100644 --- a/trans-array.c +++ b/trans-array.c @@ -8464,9 +8464,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_expr *proc_expr, gfc_ss_type type) + gfc_symbol *proc_ifc, gfc_ss_type type) { - gfc_symbol *proc_ifc; gfc_formal_arglist *dummy_arg; int scalar; gfc_ss *head; @@ -8476,7 +8475,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = NULL; - proc_ifc = gfc_get_proc_ifc_for_expr (proc_expr); if (proc_ifc) dummy_arg = proc_ifc->formal; else @@ -8566,7 +8564,8 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) by reference. */ if (sym->attr.elemental || (comp && comp->attr.elemental)) return gfc_walk_elemental_function_args (ss, expr->value.function.actual, - expr, GFC_SS_REFERENCE); + gfc_get_proc_ifc_for_expr (expr), + GFC_SS_REFERENCE); /* Scalar functions are OK as these are evaluated outside the scalarization loop. Pass back and let the caller deal with it. */ diff --git a/trans-array.h b/trans-array.h index 6ca630e..9bafb94 100644 --- a/trans-array.h +++ b/trans-array.h @@ -66,6 +66,8 @@ void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *); /* Generate an initializer for a static pointer or allocatable array. */ void gfc_trans_static_array_pointer (gfc_symbol *); +/* Get the procedure interface for a function call. */ +gfc_symbol *gfc_get_proc_ifc_for_expr (gfc_expr *); /* Generate scalarization information for an expression. */ gfc_ss *gfc_walk_expr (gfc_expr *); /* Workhorse for gfc_walk_expr. */ @@ -74,7 +76,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_expr *, gfc_ss_type); + gfc_symbol *, gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); diff --git a/trans-stmt.c b/trans-stmt.c index 7a6f8b2..ddbf35e 100644 --- a/trans-stmt.c +++ b/trans-stmt.c @@ -372,7 +372,8 @@ 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, - code->expr1, GFC_SS_REFERENCE); + gfc_get_proc_ifc_for_expr (code->expr1), + GFC_SS_REFERENCE); /* Is not an elemental subroutine call with array valued arguments. */ if (ss == gfc_ss_terminator)
Attachment:
call_interface-3.CL
Description: Text document
diff --git a/trans-stmt.c b/trans-stmt.c index ddbf35e..9b116d3 100644 --- a/trans-stmt.c +++ b/trans-stmt.c @@ -348,6 +348,27 @@ 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 @@ -372,7 +393,7 @@ 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, - gfc_get_proc_ifc_for_expr (code->expr1), + get_proc_ifc_for_call (code), GFC_SS_REFERENCE); /* Is not an elemental subroutine call with array valued arguments. */
Attachment:
call_interface-test.CL
Description: Text document
Attachment:
elemental_optional_args_5.f90
Description: Text document
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |