diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2015-01-02 12:24:32 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2015-01-02 12:24:32 +0100 |
| commit | 4294c0935c186a724f044c36ca9693a7138853ae (patch) | |
| tree | 542766813f11cd3b0d5385996b80feeea40828ca /gcc/fortran/interface.c | |
| parent | 007adc0d7920a6c8600ad039c1ddaae377cb61c8 (diff) | |
| download | gcc-4294c0935c186a724f044c36ca9693a7138853ae.zip gcc-4294c0935c186a724f044c36ca9693a7138853ae.tar.gz gcc-4294c0935c186a724f044c36ca9693a7138853ae.tar.bz2 | |
re PR fortran/60507 (Passing function call into procedure argument not caught)
2015-01-02 Janus Weil <janus@gcc.gnu.org>
PR fortran/60507
* interface.c (is_procptr_result): New function to check if an
expression is a procedure-pointer result.
(compare_actual_formal): Use it.
2015-01-02 Janus Weil <janus@gcc.gnu.org>
PR fortran/60507
* gfortran.dg/dummy_procedure_11: New.
From-SVN: r219141
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 25 |
1 files changed, 21 insertions, 4 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 04bcf12..a797f1a 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2503,6 +2503,18 @@ gfc_has_vector_subscript (gfc_expr *e) } +static bool +is_procptr_result (gfc_expr *expr) +{ + gfc_component *c = gfc_get_proc_ptr_comp (expr); + if (c) + return (c->ts.interface && (c->ts.interface->attr.proc_pointer == 1)); + else + return ((expr->symtree->n.sym->result != expr->symtree->n.sym) + && (expr->symtree->n.sym->result->attr.proc_pointer == 1)); +} + + /* Given formal and actual argument lists, see if they are compatible. If they are compatible, the actual argument list is sorted to correspond with the formal list, and elements for missing optional @@ -2724,10 +2736,10 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, argument is provided for a procedure pointer formal argument. */ if (f->sym->attr.proc_pointer && !((a->expr->expr_type == EXPR_VARIABLE - && a->expr->symtree->n.sym->attr.proc_pointer) + && (a->expr->symtree->n.sym->attr.proc_pointer + || gfc_is_proc_ptr_comp (a->expr))) || (a->expr->expr_type == EXPR_FUNCTION - && a->expr->symtree->n.sym->result->attr.proc_pointer) - || gfc_is_proc_ptr_comp (a->expr))) + && is_procptr_result (a->expr)))) { if (where) gfc_error ("Expected a procedure pointer for argument %qs at %L", @@ -2738,7 +2750,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is provided for a procedure formal argument. */ if (f->sym->attr.flavor == FL_PROCEDURE - && gfc_expr_attr (a->expr).flavor != FL_PROCEDURE) + && !((a->expr->expr_type == EXPR_VARIABLE + && (a->expr->symtree->n.sym->attr.flavor == FL_PROCEDURE + || a->expr->symtree->n.sym->attr.proc_pointer + || gfc_is_proc_ptr_comp (a->expr))) + || (a->expr->expr_type == EXPR_FUNCTION + && is_procptr_result (a->expr)))) { if (where) gfc_error ("Expected a procedure for argument %qs at %L", |