diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2008-07-02 21:53:37 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2008-07-02 21:53:37 +0200 |
| commit | 8fb74da43bd12ea5008ba9fba2173b455d494b2c (patch) | |
| tree | 22cdfa5a0f9753aaa861e0696994a9d143ec1e49 /gcc/fortran/trans-expr.c | |
| parent | 658896fbb85ebf48d21c9a08e405d0916ca1d45a (diff) | |
| download | gcc-8fb74da43bd12ea5008ba9fba2173b455d494b2c.zip gcc-8fb74da43bd12ea5008ba9fba2173b455d494b2c.tar.gz gcc-8fb74da43bd12ea5008ba9fba2173b455d494b2c.tar.bz2 | |
re PR fortran/32580 (iso_c_binding c_f_procpointer / procedure pointers)
2008-07-02 Janus Weil <janus@gcc.gnu.org>
Tobias Burnus <burnus@net-b.de>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/32580
* gfortran.h (struct gfc_symbol): New member "proc_pointer".
* check.c (gfc_check_associated,gfc_check_null): Implement
procedure pointers.
* decl.c (match_procedure_decl): Ditto.
* expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol): Ditto.
* interface.c (compare_actual_formal): Ditto.
* match.h: Ditto.
* match.c (gfc_match_pointer_assignment): Ditto.
* parse.c (parse_interface): Ditto.
* primary.c (gfc_match_rvalue,match_variable): Ditto.
* resolve.c (resolve_fl_procedure): Ditto.
* symbol.c (check_conflict,gfc_add_external,gfc_add_pointer,
gfc_copy_attr,gen_fptr_param,build_formal_args): Ditto.
* trans-decl.c (get_proc_pointer_decl,gfc_get_extern_function_decl,
create_function_arglist): Ditto.
* trans-expr.c (gfc_conv_variable,gfc_conv_function_val,
gfc_conv_function_call,gfc_trans_pointer_assignment): Ditto.
2008-07-02 Janus Weil <janus@gcc.gnu.org>
Tobias Burnus <burnus@net-b.de>
PR fortran/32580
* gfortran.dg/c_f_pointer_tests_3.f90: Updated.
* gfortran.dg/proc_decl_1.f90: Updated.
* gfortran.dg/proc_ptr_1.f90: New.
* gfortran.dg/proc_ptr_2.f90: New.
* gfortran.dg/proc_ptr_3.f90: New.
* gfortran.dg/proc_ptr_4.f90: New.
* gfortran.dg/proc_ptr_5.f90: New.
* gfortran.dg/proc_ptr_6.f90: New.
* gfortran.dg/proc_ptr_7.f90: New.
* gfortran.dg/proc_ptr_8.f90: New.
Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>
Co-Authored-By: Tobias Burnus <burnus@net-b.de>
From-SVN: r137386
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 59a0a2d..570e07b 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -480,8 +480,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) else if (sym->attr.flavor == FL_PROCEDURE && se->expr != current_function_decl) { - gcc_assert (se->want_pointer); - if (!sym->attr.dummy) + if (!sym->attr.dummy && !sym->attr.proc_pointer) { gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL); se->expr = build_fold_addr_expr (se->expr); @@ -1372,6 +1371,8 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym) if (sym->attr.dummy) { tmp = gfc_get_symbol_decl (sym); + if (sym->attr.proc_pointer) + tmp = build_fold_indirect_ref (tmp); gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE && TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE); } @@ -2498,9 +2499,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, else { gfc_conv_expr_reference (&parmse, e); - if (fsym && fsym->attr.pointer - && fsym->attr.flavor != FL_PROCEDURE - && e->expr_type != EXPR_NULL) + if (fsym && e->expr_type != EXPR_NULL + && ((fsym->attr.pointer + && fsym->attr.flavor != FL_PROCEDURE) + || fsym->attr.proc_pointer)) { /* Scalar pointer dummy args require an extra level of indirection. The null pointer already contains @@ -3867,6 +3869,11 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_init_se (&rse, NULL); rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); + + if (expr1->symtree->n.sym->attr.proc_pointer + && expr1->symtree->n.sym->attr.dummy) + lse.expr = build_fold_indirect_ref (lse.expr); + gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); gfc_add_modify_expr (&block, lse.expr, |