From: Tobias Burnus Date: Sun, 25 May 2008 17:52:03 +0000 (+0200) Subject: re PR fortran/32600 ([ISO Bind C] C_F_POINTER w/o SHAPE should not be a library function) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5ec81069e5422ce9e606abc35ff3152a9478caf5;p=gcc.git re PR fortran/32600 ([ISO Bind C] C_F_POINTER w/o SHAPE should not be a library function) 2008-05-25 Tobias Burnus PR fortran/32600 * trans-expr.c (gfc_conv_function_call): Remove library call for c_f_pointer with scalar Fortran pointers and for c_f_procpointer. 2008-05-25 Tobias Burnus PR fortran/32600 * intrinsics/iso_c_binding.c (c_f_procpointer): Remove. * intrinsics/iso_c_binding.h (c_f_procpointer): Remove. * gfortran.map (c_f_procpointer): Remove. 2008-05-25 Tobias Burnus PR fortran/32600 * gfortran.dg/c_f_pointer_tests_3.f90: New. From-SVN: r135877 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0161a2a79c9..5c85a65eeec 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-05-25 Tobias Burnus + + PR fortran/32600 + * trans-expr.c (gfc_conv_function_call): Remove library + call for c_f_pointer with scalar Fortran pointers and for + c_f_procpointer. + 2008-05-21 Francois-Xavier Coudert PR fortran/36257 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6deaad65f04..cfd33e464bc 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2317,6 +2317,34 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, arg->expr->ts.kind = sym->ts.derived->ts.kind; gfc_conv_expr_reference (se, arg->expr); + return 0; + } + else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER + && arg->next->expr->rank == 0) + || sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER) + { + /* Convert c_f_pointer if fptr is a scalar + and convert c_f_procpointer. */ + gfc_se cptrse; + gfc_se fptrse; + + gfc_init_se (&cptrse, NULL); + gfc_conv_expr (&cptrse, arg->expr); + gfc_add_block_to_block (&se->pre, &cptrse.pre); + gfc_add_block_to_block (&se->post, &cptrse.post); + + gfc_init_se (&fptrse, NULL); + if (sym->intmod_sym_id == ISOCBINDING_F_POINTER) + fptrse.want_pointer = 1; + + 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); + + tmp = arg->next->expr->symtree->n.sym->backend_decl; + se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), fptrse.expr, + fold_convert (TREE_TYPE (tmp), cptrse.expr)); + return 0; } else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 27e51f85db2..2cc96bf4f26 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-05-25 Tobias Burnus + + PR fortran/32600 + * gfortran.dg/c_f_pointer_tests_3.f90: New. + 2008-05-25 Richard Guenther PR tree-optimization/17526 diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 new file mode 100644 index 00000000000..525af506428 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-options "-O2 -fdump-tree-original" } +! +! PR fortran/32600 c_f_pointer w/o shape +! PR fortran/32580 c_f_procpointer +! +! Verify that c_f_prointer [w/o shape] and c_f_procpointer generate +! the right code - and no library call + +program test + use iso_c_binding + implicit none + type(c_ptr) :: cptr + type(c_funptr) :: cfunptr + integer(4), pointer :: fptr + integer(4), pointer :: fptr_array(:) +! procedure(integer(4)), pointer :: fprocptr ! TODO + + call c_f_pointer(cptr, fptr) + call c_f_pointer(cptr, fptr_array, [ 1 ]) +! call c_f_procpointer(cfunptr, fprocptr) ! TODO +end program test + +! Make sure there is only a single function call: +! { dg-final { scan-tree-dump-times "c_f" 1 "original" } } +! { dg-final { scan-tree-dump-times "c_f_pointer" 1 "original" } } +! { dg-final { scan-tree-dump-times "c_f_pointer_i4" 1 "original" } } +! +! Check scalar c_f_pointer +! { dg-final { scan-tree-dump-times " fptr = .integer.kind=4. .. cptr" 1 "original" } } +! +! Check c_f_procpointer +! TODO { scan-tree-dump-times " fprocptr = .integer.kind=4. .\\*<.*>. .void.. cfunptr;" 1 "original" } } TODO +! +! { dg-final { cleanup-tree-dump "original" } } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 81820965ca6..877ab624351 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2008-05-25 Tobias Burnus + + PR fortran/32600 + * intrinsics/iso_c_binding.c (c_f_procpointer): Remove. + * intrinsics/iso_c_binding.h (c_f_procpointer): Remove. + * gfortran.map (c_f_procpointer): Remove. + 2008-05-22 Thomas Koenig PR libgfortran/36302 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index b61ce87990e..4244acab5f8 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1026,7 +1026,6 @@ GFORTRAN_1.0 { __iso_c_binding_c_f_pointer_l4; __iso_c_binding_c_f_pointer_l8; __iso_c_binding_c_f_pointer_u0; - __iso_c_binding_c_f_procpointer; local: *; }; diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index 2a1e994d4d9..171b1524751 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -180,16 +180,3 @@ ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr_in, | (GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT); } } - - -/* This function will change, once there is an actual f90 type for the - procedure pointer. */ - -void -ISO_C_BINDING_PREFIX (c_f_procpointer) (void *c_ptr_in, - gfc_array_void *f_ptr_out) -{ - GFC_DESCRIPTOR_DATA(f_ptr_out) = c_ptr_in; -} - - diff --git a/libgfortran/intrinsics/iso_c_binding.h b/libgfortran/intrinsics/iso_c_binding.h index 4679c2aba02..cb1a7a066b7 100644 --- a/libgfortran/intrinsics/iso_c_binding.h +++ b/libgfortran/intrinsics/iso_c_binding.h @@ -52,10 +52,6 @@ c_funptr_t; void ISO_C_BINDING_PREFIX(c_f_pointer)(void *, gfc_array_void *, const array_t *, int, int); -/* The second param here may change, once procedure pointers are - implemented. */ -void ISO_C_BINDING_PREFIX(c_f_procpointer) (void *, gfc_array_void *); - void ISO_C_BINDING_PREFIX(c_f_pointer_u0) (void *, gfc_array_void *, const array_t *); void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *,