This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, Fortran] c_f_pointer, c_f_procpointer patch (PR32600)
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Sat, 24 May 2008 22:08:14 +0200
- Subject: [Patch, Fortran] c_f_pointer, c_f_procpointer patch (PR32600)
Hi,
For c_f_pointer(cptr, fptr [, shape]), gfortran currently always calls
the library. While it makes sense to do so if the Fortran pointer is an
array, it is not needed for scalar pointers. (In that case shape is not
present.)
This patch simply changes c_f_pointer(cptr, fptr) into
fptr = cptr;
Unfortunately, we cannot remove the now obsolete function from the library.
For c_f_procpointer(cfunptr, fprocptr) it also gets rid of the library
call [which did not work anyhow]. As c_f_procpointer was never callable,
I could remove it from the library. (The c_f_procpointer part was tested
with Janus' procpointer patch.)
Build and regression tested on x86-64. OK for the trunk?
Tobias
PS: When Janus' patch is checked in, the test case should be updated.
(Trivial, see TODO lines.)
2008-05-24 Tobias Burnus <burnus@net-b.de>
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-24 Tobias Burnus <burnus@net-b.de>
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-24 Tobias Burnus <burnus@net-b.de>
PR fortran/32600
* gfortran.dg/c_f_pointer_tests_3.f90: New.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 135851)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -2319,6 +2319,34 @@ gfc_conv_function_call (gfc_se * se, gfc
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)
{
gfc_se arg1se;
Index: libgfortran/intrinsics/iso_c_binding.c
===================================================================
--- libgfortran/intrinsics/iso_c_binding.c (Revision 135849)
+++ libgfortran/intrinsics/iso_c_binding.c (Arbeitskopie)
@@ -180,16 +180,3 @@ ISO_C_BINDING_PREFIX (c_f_pointer_d0) (v
| (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;
-}
-
-
Index: libgfortran/intrinsics/iso_c_binding.h
===================================================================
--- libgfortran/intrinsics/iso_c_binding.h (Revision 135849)
+++ libgfortran/intrinsics/iso_c_binding.h (Arbeitskopie)
@@ -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 *,
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map (Revision 135849)
+++ libgfortran/gfortran.map (Arbeitskopie)
@@ -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:
*;
};
Index: gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 (Revision 0)
@@ -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" } }