From bf16f69e77a3ff1f3c1c5536ac70490a75ccce06 Mon Sep 17 00:00:00 2001 From: mikael Date: Sun, 12 Feb 2012 15:12:21 +0000 Subject: [PATCH 1/1] * trans-array.c (gfc_get_proc_ifc_for_expr): New function. (gfc_walk_elemental_function_args): Move code to gfc_get_proc_ifc_for_expr and call it. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@184139 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 52 +++++++++++++++++++++++++++++++---------------- 2 files changed, 40 insertions(+), 18 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 10d4abc2866..6883032022f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-02-12 Mikael Morin + + * trans-array.c (gfc_get_proc_ifc_for_expr): New function. + (gfc_walk_elemental_function_args): Move code to + gfc_get_proc_ifc_for_expr and call it. + 2012-02-08 Tobias Burnus PR fortran/52151 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index edcde5c4c0c..ac39fdf8a23 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8426,6 +8426,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. @@ -8435,6 +8465,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; @@ -8444,24 +8475,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; -- 2.11.0