This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]