From: mikael Date: Tue, 14 Aug 2012 16:28:29 +0000 (+0000) Subject: fortran/ X-Git-Tag: upstream/4.9.2~11158 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=b3961d7b2fa3f0656842e1095114db9f533fae87;p=platform%2Fupstream%2Flinaro-gcc.git fortran/ * gfortran.h (gfc_get_proc_ptr_comp): New prototype. (gfc_is_proc_ptr_comp): Update prototype. * expr.c (gfc_get_proc_ptr_comp): New function based on the old gfc_is_proc_ptr_comp. (gfc_is_proc_ptr_comp): Call gfc_get_proc_ptr_comp. (gfc_specification_expr, gfc_check_pointer_assign): Use gfc_get_proc_ptr_comp. * trans-array.c (gfc_walk_function_expr): Likewise. * resolve.c (resolve_structure_cons, update_ppc_arglist, resolve_ppc_call, resolve_expr_ppc): Likewise. (resolve_function): Update call to gfc_is_proc_ptr_comp. * dump-parse-tree.c (show_expr): Likewise. * interface.c (compare_actual_formal): Likewise. * match.c (gfc_match_pointer_assignment): Likewise. * primary.c (gfc_match_varspec): Likewise. * trans-io.c (gfc_trans_transfer): Likewise. * trans-expr.c (gfc_conv_variable, conv_function_val, conv_isocbinding_procedure, gfc_conv_procedure_call, gfc_trans_pointer_assignment): Likewise. (gfc_conv_procedure_call, gfc_trans_array_func_assign): Use gfc_get_proc_ptr_comp. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@190391 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 039c1c3..6309b5a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,27 @@ +2012-08-14 Mikael Morin + + * gfortran.h (gfc_get_proc_ptr_comp): New prototype. + (gfc_is_proc_ptr_comp): Update prototype. + * expr.c (gfc_get_proc_ptr_comp): New function based on the old + gfc_is_proc_ptr_comp. + (gfc_is_proc_ptr_comp): Call gfc_get_proc_ptr_comp. + (gfc_specification_expr, gfc_check_pointer_assign): Use + gfc_get_proc_ptr_comp. + * trans-array.c (gfc_walk_function_expr): Likewise. + * resolve.c (resolve_structure_cons, update_ppc_arglist, + resolve_ppc_call, resolve_expr_ppc): Likewise. + (resolve_function): Update call to gfc_is_proc_ptr_comp. + * dump-parse-tree.c (show_expr): Likewise. + * interface.c (compare_actual_formal): Likewise. + * match.c (gfc_match_pointer_assignment): Likewise. + * primary.c (gfc_match_varspec): Likewise. + * trans-io.c (gfc_trans_transfer): Likewise. + * trans-expr.c (gfc_conv_variable, conv_function_val, + conv_isocbinding_procedure, gfc_conv_procedure_call, + gfc_trans_pointer_assignment): Likewise. + (gfc_conv_procedure_call, gfc_trans_array_func_assign): + Use gfc_get_proc_ptr_comp. + 2012-08-14 Tobias Burnus PR fortran/40881 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 681dc8d..cb8fab4 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -569,7 +569,7 @@ show_expr (gfc_expr *p) if (p->value.function.name == NULL) { fprintf (dumpfile, "%s", p->symtree->n.sym->name); - if (gfc_is_proc_ptr_comp (p, NULL)) + if (gfc_is_proc_ptr_comp (p)) show_ref (p->ref); fputc ('[', dumpfile); show_actual_arglist (p->value.function.actual); @@ -578,7 +578,7 @@ show_expr (gfc_expr *p) else { fprintf (dumpfile, "%s", p->value.function.name); - if (gfc_is_proc_ptr_comp (p, NULL)) + if (gfc_is_proc_ptr_comp (p)) show_ref (p->ref); fputc ('[', dumpfile); fputc ('[', dumpfile); diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index aeb224f..7d74528 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2962,12 +2962,12 @@ gfc_specification_expr (gfc_expr *e) return FAILURE; } + comp = gfc_get_proc_ptr_comp (e); if (e->expr_type == EXPR_FUNCTION - && !e->value.function.isym - && !e->value.function.esym - && !gfc_pure (e->symtree->n.sym) - && (!gfc_is_proc_ptr_comp (e, &comp) - || !comp->attr.pure)) + && !e->value.function.isym + && !e->value.function.esym + && !gfc_pure (e->symtree->n.sym) + && (!comp || !comp->attr.pure)) { gfc_error ("Function '%s' at %L must be PURE", e->symtree->n.sym->name, &e->where); @@ -3495,12 +3495,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } } - if (gfc_is_proc_ptr_comp (lvalue, &comp)) + comp = gfc_get_proc_ptr_comp (lvalue); + if (comp) s1 = comp->ts.interface; else s1 = lvalue->symtree->n.sym; - if (gfc_is_proc_ptr_comp (rvalue, &comp)) + comp = gfc_get_proc_ptr_comp (rvalue); + if (comp) { s2 = comp->ts.interface; name = comp->name; @@ -4075,31 +4077,35 @@ gfc_expr_set_symbols_referenced (gfc_expr *expr) } -/* Determine if an expression is a procedure pointer component. If yes, the - argument 'comp' will point to the component (provided that 'comp' was - provided). */ +/* Determine if an expression is a procedure pointer component and return + the component in that case. Otherwise return NULL. */ -bool -gfc_is_proc_ptr_comp (gfc_expr *expr, gfc_component **comp) +gfc_component * +gfc_get_proc_ptr_comp (gfc_expr *expr) { gfc_ref *ref; - bool ppc = false; if (!expr || !expr->ref) - return false; + return NULL; ref = expr->ref; while (ref->next) ref = ref->next; - if (ref->type == REF_COMPONENT) - { - ppc = ref->u.c.component->attr.proc_pointer; - if (ppc && comp) - *comp = ref->u.c.component; - } + if (ref->type == REF_COMPONENT + && ref->u.c.component->attr.proc_pointer) + return ref->u.c.component; + + return NULL; +} + - return ppc; +/* Determine if an expression is a procedure pointer component. */ + +bool +gfc_is_proc_ptr_comp (gfc_expr *expr) +{ + return (gfc_get_proc_ptr_comp (expr) != NULL); } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0e2130f..7c4c0a4 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2766,7 +2766,8 @@ 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 *); -bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **); +gfc_component * gfc_get_proc_ptr_comp (gfc_expr *); +bool gfc_is_proc_ptr_comp (gfc_expr *); bool gfc_ref_this_image (gfc_ref *ref); bool gfc_is_coindexed (gfc_expr *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 473cfd1..482c294 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2558,7 +2558,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && a->expr->symtree->n.sym->attr.proc_pointer) || (a->expr->expr_type == EXPR_FUNCTION && a->expr->symtree->n.sym->result->attr.proc_pointer) - || gfc_is_proc_ptr_comp (a->expr, NULL))) + || gfc_is_proc_ptr_comp (a->expr))) { if (where) gfc_error ("Expected a procedure pointer for argument '%s' at %L", @@ -2568,7 +2568,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* Satisfy 12.4.1.2 by ensuring that a procedure actual argument is provided for a procedure formal argument. */ - if (a->expr->ts.type != BT_PROCEDURE && !gfc_is_proc_ptr_comp (a->expr, NULL) + if (a->expr->ts.type != BT_PROCEDURE && !gfc_is_proc_ptr_comp (a->expr) && a->expr->expr_type == EXPR_VARIABLE && f->sym->attr.flavor == FL_PROCEDURE) { diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 5ab07e5..0b1cf5a 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1344,7 +1344,7 @@ gfc_match_pointer_assignment (void) } if (lvalue->symtree->n.sym->attr.proc_pointer - || gfc_is_proc_ptr_comp (lvalue, NULL)) + || gfc_is_proc_ptr_comp (lvalue)) gfc_matching_procptr_assignment = 1; else gfc_matching_ptr_assignment = 1; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 29d2789..cadc20c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1862,7 +1862,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if ((equiv_flag && gfc_peek_ascii_char () == '(') || gfc_peek_ascii_char () == '[' || sym->attr.codimension || (sym->attr.dimension && sym->ts.type != BT_CLASS - && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary, NULL) + && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary) && !(gfc_matching_procptr_assignment && sym->attr.flavor == FL_PROCEDURE)) || (sym->ts.type == BT_CLASS && sym->attr.class_ok diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9b8033d..c706b89 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1195,7 +1195,8 @@ resolve_structure_cons (gfc_expr *expr, int init) const char *name; char err[200]; - if (gfc_is_proc_ptr_comp (cons->expr, &c2)) + c2 = gfc_get_proc_ptr_comp (cons->expr); + if (c2) { s2 = c2->ts.interface; name = c2->name; @@ -3093,9 +3094,9 @@ resolve_function (gfc_expr *expr) sym = expr->symtree->n.sym; /* If this is a procedure pointer component, it has already been resolved. */ - if (gfc_is_proc_ptr_comp (expr, NULL)) + if (gfc_is_proc_ptr_comp (expr)) return SUCCESS; - + if (sym && sym->attr.intrinsic && gfc_resolve_intrinsic (sym, &expr->where) == FAILURE) return FAILURE; @@ -5740,7 +5741,8 @@ update_ppc_arglist (gfc_expr* e) gfc_component *ppc; gfc_typebound_proc* tb; - if (!gfc_is_proc_ptr_comp (e, &ppc)) + ppc = gfc_get_proc_ptr_comp (e); + if (!ppc) return FAILURE; tb = ppc->tb; @@ -6363,10 +6365,9 @@ static gfc_try resolve_ppc_call (gfc_code* c) { gfc_component *comp; - bool b; - b = gfc_is_proc_ptr_comp (c->expr1, &comp); - gcc_assert (b); + comp = gfc_get_proc_ptr_comp (c->expr1); + gcc_assert (comp != NULL); c->resolved_sym = c->expr1->symtree->n.sym; c->expr1->expr_type = EXPR_VARIABLE; @@ -6398,10 +6399,9 @@ static gfc_try resolve_expr_ppc (gfc_expr* e) { gfc_component *comp; - bool b; - b = gfc_is_proc_ptr_comp (e, &comp); - gcc_assert (b); + comp = gfc_get_proc_ptr_comp (e); + gcc_assert (comp != NULL); /* Convert to EXPR_FUNCTION. */ e->expr_type = EXPR_FUNCTION; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index ef25a36..8c254dd 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8666,7 +8666,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) sym = expr->symtree->n.sym; /* A function that returns arrays. */ - gfc_is_proc_ptr_comp (expr, &comp); + comp = gfc_get_proc_ptr_comp (expr); if ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension) || (comp && comp->attr.dimension)) return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_FUNCTION); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 2603995..12a75d0 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1512,9 +1512,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) separately. */ if (se->want_pointer) { - if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr, NULL)) + if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr)) gfc_conv_string_parameter (se); - else + else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); } } @@ -2438,7 +2438,7 @@ conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr) { tree tmp; - if (gfc_is_proc_ptr_comp (expr, NULL)) + if (gfc_is_proc_ptr_comp (expr)) tmp = get_proc_ptr_comp (expr); else if (sym->attr.dummy) { @@ -3447,7 +3447,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym, if (arg->next->expr->rank == 0) { if (sym->intmod_sym_id == ISOCBINDING_F_POINTER - || gfc_is_proc_ptr_comp (arg->next->expr, NULL)) + || gfc_is_proc_ptr_comp (arg->next->expr)) fptrse.want_pointer = 1; gfc_conv_expr (&fptrse, arg->next->expr); @@ -3649,7 +3649,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && conv_isocbinding_procedure (se, sym, args)) return 0; - gfc_is_proc_ptr_comp (expr, &comp); + comp = gfc_get_proc_ptr_comp (expr); if (se->ss != NULL) { @@ -3958,7 +3958,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && e->symtree->n.sym->attr.dummy)) || (fsym->attr.proc_pointer && e->expr_type == EXPR_VARIABLE - && gfc_is_proc_ptr_comp (e, NULL)) + && gfc_is_proc_ptr_comp (e)) || (fsym->attr.allocatable && fsym->attr.flavor != FL_PROCEDURE))) { @@ -6007,7 +6007,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL && !expr1->ts.deferred && !expr1->symtree->n.sym->attr.proc_pointer - && !gfc_is_proc_ptr_comp (expr1, NULL)) + && !gfc_is_proc_ptr_comp (expr1)) { gcc_assert (expr2->ts.type == BT_CHARACTER); gcc_assert (lse.string_length && rse.string_length); @@ -6700,9 +6700,9 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) /* The frontend doesn't seem to bother filling in expr->symtree for intrinsic functions. */ + comp = gfc_get_proc_ptr_comp (expr2); gcc_assert (expr2->value.function.isym - || (gfc_is_proc_ptr_comp (expr2, &comp) - && comp && comp->attr.dimension) + || (comp && comp->attr.dimension) || (!comp && gfc_return_by_reference (expr2->value.function.esym) && expr2->value.function.esym->result->attr.dimension)); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 8218f85..9d7d5b6 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2252,7 +2252,7 @@ gfc_trans_transfer (gfc_code * code) /* Transfer an array. If it is an array of an intrinsic type, pass the descriptor to the library. Otherwise scalarize the transfer. */ - if (expr->ref && !gfc_is_proc_ptr_comp (expr, NULL)) + if (expr->ref && !gfc_is_proc_ptr_comp (expr)) { for (ref = expr->ref; ref && ref->type != REF_ARRAY; ref = ref->next);