mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-01-12 23:35:44 +08:00
re PR fortran/42072 ([F03] wrong-code with C_F_PROCPOINTER)
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. From-SVN: r154292
This commit is contained in:
parent
965b98d04b
commit
827c5be4f7
@ -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.
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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" } }
|
||||
|
Loading…
Reference in New Issue
Block a user