From e35bbb23ad67dac0f5d0a5b7dd1b27470c1acc78 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 18 May 2009 16:44:55 +0200 Subject: re PR fortran/40164 (Fortran 2003: "Arrays of procedure pointers" (using PPCs)) 2009-05-18 Janus Weil PR fortran/40164 * primary.c (gfc_match_rvalue): Handle procedure pointer components in arrays. * resolve.c (resolve_ppc_call,resolve_expr_ppc): Resolve component and array references. (resolve_fl_derived): Procedure pointer components are not required to have constant array bounds in their return value. 2009-05-18 Janus Weil PR fortran/40164 * gfortran.dg/proc_ptr_comp_8.f90: New. From-SVN: r147663 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/primary.c | 2 +- gcc/fortran/resolve.c | 9 ++++++++- 3 files changed, 19 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f7e47fc..c02a326 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,15 @@ 2009-05-18 Janus Weil + PR fortran/40164 + * primary.c (gfc_match_rvalue): Handle procedure pointer components in + arrays. + * resolve.c (resolve_ppc_call,resolve_expr_ppc): Resolve component and + array references. + (resolve_fl_derived): Procedure pointer components are not required to + have constant array bounds in their return value. + +2009-05-18 Janus Weil + * intrinsic.c (add_sym): Fix my last commit (r147655), which broke bootstrap. diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 96fbddc..4d39c1a 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2558,7 +2558,7 @@ gfc_match_rvalue (gfc_expr **result) if (gfc_matching_procptr_assignment) { gfc_gobble_whitespace (); - if (gfc_peek_ascii_char () == '(') + if (!sym->attr.dimension && gfc_peek_ascii_char () == '(') /* Parse functions returning a procptr. */ goto function0; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d3097c4..39eb043 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4840,6 +4840,9 @@ resolve_ppc_call (gfc_code* c) if (!comp->attr.subroutine) gfc_add_subroutine (&comp->attr, comp->name, &c->expr1->where); + if (resolve_ref (c->expr1) == FAILURE) + return FAILURE; + if (resolve_actual_arglist (c->ext.actual, comp->attr.proc, comp->formal == NULL) == FAILURE) return FAILURE; @@ -4869,6 +4872,9 @@ resolve_expr_ppc (gfc_expr* e) if (!comp->attr.function) gfc_add_function (&comp->attr, comp->name, &e->where); + if (resolve_ref (e) == FAILURE) + return FAILURE; + if (resolve_actual_arglist (e->value.function.actual, comp->attr.proc, comp->formal == NULL) == FAILURE) return FAILURE; @@ -9147,7 +9153,8 @@ resolve_fl_derived (gfc_symbol *sym) && sym != c->ts.derived) add_dt_to_dt_list (c->ts.derived); - if (c->attr.pointer || c->attr.allocatable || c->as == NULL) + if (c->attr.pointer || c->attr.proc_pointer || c->attr.allocatable + || c->as == NULL) continue; for (i = 0; i < c->as->rank; i++) -- cgit v1.1