re PR fortran/32600 ([ISO Bind C] C_F_POINTER w/o SHAPE should not be a library function)
authorTobias Burnus <burnus@net-b.de>
Sun, 25 May 2008 17:52:03 +0000 (19:52 +0200)
committerTobias Burnus <burnus@gcc.gnu.org>
Sun, 25 May 2008 17:52:03 +0000 (19:52 +0200)
2008-05-25  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-25  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-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/32600
        * gfortran.dg/c_f_pointer_tests_3.f90: New.

From-SVN: r135877

gcc/fortran/ChangeLog
gcc/fortran/trans-expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/gfortran.map
libgfortran/intrinsics/iso_c_binding.c
libgfortran/intrinsics/iso_c_binding.h

index 0161a2a79c90d417fd59aed8d8167be7440acb3e..5c85a65eeeca72b11b1101fde25f305e2a46fe7d 100644 (file)
@@ -1,3 +1,10 @@
+2008-05-25  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-21  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        PR fortran/36257
index 6deaad65f04a380e695d9df5dff5f2125a740a2d..cfd33e464bc544547e554375c89fb70cacf35058 100644 (file)
@@ -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)
index 27e51f85db211361fc144da8f08e370c920469cc..2cc96bf4f26e9c4a5759ced328ce70cbadfc87d4 100644 (file)
@@ -1,3 +1,8 @@
+2008-05-25  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/32600
+       * gfortran.dg/c_f_pointer_tests_3.f90: New.
+
 2008-05-25  Richard Guenther  <rguenther@suse.de>
 
        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 (file)
index 0000000..525af50
--- /dev/null
@@ -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 81820965ca6a1259f98c9c0ee9c213464444984e..877ab6243517d6e56ef1574af08027b2ed688258 100644 (file)
@@ -1,3 +1,10 @@
+2008-05-25  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-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR libgfortran/36302
index b61ce87990ed08669e0fcf220985cbb9c0657e90..4244acab5f874dc8a07022419128ba10c77d060e 100644 (file)
@@ -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 2a1e994d4d9243e8f4638796de98d4508ae253f0..171b152475149c0a976fb456421f28bda52de2ab 100644 (file)
@@ -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;
-}
-
-
index 4679c2aba02f4be2d771c2415fc504b54d3644ab..cb1a7a066b713e3a802ba91d0b397081ff1c8c53 100644 (file)
@@ -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 *,