diff options
author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-11-24 08:16:32 +0000 |
---|---|---|
committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-11-24 08:16:32 +0000 |
commit | ffe221be5de13e10d034dfec9a01b44aa96ea8b3 (patch) | |
tree | 1822559a7e676edd10dfddc440d395b5f5a3cb49 /gcc/fortran | |
parent | 1270a51a44684c19fd9d9096252d371c107b878d (diff) | |
download | gcc-ffe221be5de13e10d034dfec9a01b44aa96ea8b3.tar.gz |
2009-11-24 Janus Weil <janus@gcc.gnu.org>
PR fortran/42045
* resolve.c (resolve_actual_arglist): Make sure procedure pointer
actual arguments are resolved correctly.
(resolve_function): An EXPR_FUNCTION which is a procedure pointer
component, has already been resolved.
(resolve_fl_derived): Procedure pointer components should not be
implicitly typed.
2009-11-24 Janus Weil <janus@gcc.gnu.org>
PR fortran/42045
* gfortran.dg/proc_ptr_comp_2.f90: Correct invalid test case.
* gfortran.dg/proc_ptr_comp_3.f90: Extended test case.
* gfortran.dg/proc_ptr_comp_24.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154492 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 11 |
2 files changed, 19 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 64061e7682e..862fffa663a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2009-11-24 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42045 + * resolve.c (resolve_actual_arglist): Make sure procedure pointer + actual arguments are resolved correctly. + (resolve_function): An EXPR_FUNCTION which is a procedure pointer + component, has already been resolved. + (resolve_fl_derived): Procedure pointer components should not be + implicitly typed. + 2009-11-21 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/41807 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index bd690a71f0e..740679edd2d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1321,6 +1321,8 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, e->rank = comp->as->rank; e->expr_type = EXPR_FUNCTION; } + if (gfc_resolve_expr (e) == FAILURE) + return FAILURE; goto argument_list; } @@ -2519,6 +2521,10 @@ resolve_function (gfc_expr *expr) if (expr->symtree) 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)) + return SUCCESS; + if (sym && sym->attr.intrinsic && resolve_intrinsic (sym, &expr->where) == FAILURE) return FAILURE; @@ -10219,8 +10225,9 @@ resolve_fl_derived (gfc_symbol *sym) } else if (c->attr.proc_pointer && c->ts.type == BT_UNKNOWN) { - c->ts = *gfc_get_default_type (c->name, NULL); - c->attr.implicit_type = 1; + /* Since PPCs are not implicitly typed, a PPC without an explicit + interface must be a subroutine. */ + gfc_add_subroutine (&c->attr, c->name, &c->loc); } /* Procedure pointer components: Check PASS arg. */ |