From 0fd53ac9e79421de9b0d1f42521f15e9845983e7 Mon Sep 17 00:00:00 2001 From: janus Date: Tue, 25 Aug 2009 14:26:44 +0000 Subject: 2009-08-25 Janus Weil PR fortran/41139 * primary.c (gfc_match_varspec): Make sure EXPR_PPC is only used for calls to procedure pointer components, other references to procedure pointer components are EXPR_VARIABLE. * resolve.c (resolve_actual_arglist): Bugfix (there can be calls without actual arglist). * trans-expr.c (gfc_get_proc_ptr_comp): Renamed to 'get_proc_ptr_comp', removed argument 'se' and made static. Avoid inserting a temporary variable for calling the PPC. (conv_function_val): Renamed gfc_get_proc_ptr_comp. (gfc_conv_procedure_call): Distinguish functions returning a procedure pointer from calls to a procedure pointer. Distinguish calls to procedure pointer components from procedure pointer components as actual arguments. * trans-stmt.h (gfc_get_proc_ptr_comp): Make it static. 2009-08-25 Janus Weil PR fortran/41139 * gfortran.dg/proc_ptr_25.f90: New. * gfortran.dg/proc_ptr_comp_18.f90: New. * gfortran.dg/proc_ptr_comp_19.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151081 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-expr.c | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) (limited to 'gcc/fortran/trans-expr.c') diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 3f5e76d137d..a5677f70d8d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1502,13 +1502,29 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind) return tmp; } + +/* Return the backend_decl for a procedure pointer component. */ + +static tree +get_proc_ptr_comp (gfc_expr *e) +{ + gfc_se comp_se; + gfc_expr *e2; + gfc_init_se (&comp_se, NULL); + e2 = gfc_copy_expr (e); + e2->expr_type = EXPR_VARIABLE; + gfc_conv_expr (&comp_se, e2); + return build_fold_addr_expr_loc (input_location, comp_se.expr); +} + + static void conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr) { tree tmp; if (gfc_is_proc_ptr_comp (expr, NULL)) - tmp = gfc_get_proc_ptr_comp (se, expr); + tmp = get_proc_ptr_comp (expr); else if (sym->attr.dummy) { tmp = gfc_get_symbol_decl (sym); @@ -2679,6 +2695,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } else if (e->expr_type == EXPR_FUNCTION && e->symtree->n.sym->result + && e->symtree->n.sym->result != e->symtree->n.sym && e->symtree->n.sym->result->attr.proc_pointer) { /* Functions returning procedure pointers. */ @@ -2695,7 +2712,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, || (fsym->attr.proc_pointer && !(e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.dummy)) - || gfc_is_proc_ptr_comp (e, NULL))) + || (e->expr_type == EXPR_VARIABLE + && gfc_is_proc_ptr_comp (e, NULL)))) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains @@ -3501,22 +3519,6 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr) } -/* Return the backend_decl for a procedure pointer component. */ - -tree -gfc_get_proc_ptr_comp (gfc_se *se, gfc_expr *e) -{ - gfc_se comp_se; - gfc_expr *e2; - gfc_init_se (&comp_se, NULL); - e2 = gfc_copy_expr (e); - e2->expr_type = EXPR_VARIABLE; - gfc_conv_expr (&comp_se, e2); - comp_se.expr = build_fold_addr_expr_loc (input_location, comp_se.expr); - return gfc_evaluate_now (comp_se.expr, &se->pre); -} - - /* Translate a function expression. */ static void -- cgit v1.2.3