diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-11-18 13:24:54 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-11-18 13:24:54 +0000 |
| commit | 19b7a51ee94ca58ab1f8c58ccc1cc6f390c3c377 (patch) | |
| tree | e7481856097ba3bd34a1792c5acf2dbc4954abcf | |
| parent | 63aab97df901f60f2e854e6ad3e7e47fd72e74ae (diff) | |
| download | ppe42-gcc-19b7a51ee94ca58ab1f8c58ccc1cc6f390c3c377.tar.gz ppe42-gcc-19b7a51ee94ca58ab1f8c58ccc1cc6f390c3c377.zip | |
2009-11-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/42072
* trans-expr.c (gfc_conv_procedure_call): Handle procedure pointer
dummies which are passed to C_F_PROCPOINTER.
2009-11-18 Janus Weil <janus@gcc.gnu.org>
PR fortran/42072
* gfortran.dg/proc_ptr_8.f90: Extended.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154292 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 17 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_8.f90 | 13 |
4 files changed, 33 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bfdee68f0d3..e1f72a12f98 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-11-18 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42072 + * trans-expr.c (gfc_conv_procedure_call): Handle procedure pointer + dummies which are passed to C_F_PROCPOINTER. + 2009-11-18 Alexandre Oliva <aoliva@redhat.com> * module.c (mio_f2k_derived): Initialize op. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5a45f4f6368..b72d5401bae 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2640,13 +2640,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_conv_expr (&fptrse, arg->next->expr); gfc_add_block_to_block (&se->pre, &fptrse.pre); gfc_add_block_to_block (&se->post, &fptrse.post); - - if (gfc_is_proc_ptr_comp (arg->next->expr, NULL)) - tmp = gfc_get_ppc_type (arg->next->expr->ref->u.c.component); - else - tmp = TREE_TYPE (arg->next->expr->symtree->n.sym->backend_decl); - se->expr = fold_build2 (MODIFY_EXPR, tmp, fptrse.expr, - fold_convert (tmp, cptrse.expr)); + + if (arg->next->expr->symtree->n.sym->attr.proc_pointer + && arg->next->expr->symtree->n.sym->attr.dummy) + fptrse.expr = build_fold_indirect_ref_loc (input_location, + fptrse.expr); + + se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (fptrse.expr), + fptrse.expr, + fold_convert (TREE_TYPE (fptrse.expr), + cptrse.expr)); return 0; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 01961823f9e..594210fe335 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-11-18 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42072 + * gfortran.dg/proc_ptr_8.f90: Extended. + 2009-11-18 Shujing Zhao <pearly.zhao@oracle.com> * g++.old-deja/g++.other/crash28.C: Make expected dg-error strings diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_8.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_8.f90 index 80d26619bc0..f45d114f833 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_8.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_8.f90 @@ -23,12 +23,23 @@ MODULE X END MODULE X USE X -PROCEDURE(mytype), POINTER :: ptype +PROCEDURE(mytype), POINTER :: ptype,ptype2 CALL init() CALL C_F_PROCPOINTER(funpointer,ptype) if (ptype(3) /= 9) call abort() +! the stuff below was added with PR 42072 +call setpointer(ptype2) +if (ptype2(4) /= 12) call abort() + +contains + + subroutine setpointer (p) + PROCEDURE(mytype), POINTER :: p + CALL C_F_PROCPOINTER(funpointer,p) + end subroutine + END ! { dg-final { cleanup-modules "X" } } |
