[PATCH,fortran]: fix pr32627 and other c_f_pointer funcs
Christopher D. Rickett
crickett@lanl.gov
Mon Jul 16 19:02:00 GMT 2007
hi all,
the attached patch addresses pr32627, which was about c_f_pointer_s1 being
undefined. in general, c_f_pointer functions did not exist for
character/string, logical, or complex types. the attached patch supplies
them.
bootstrapped and regtested on x86 and x86_64 linux with no new failures.
Chris
:ADDPATCH fortran:
2007-07-16 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32627
* resolve.c (set_name_and_label): Set kind number for character
version of c_f_pointer.
2007-07-16 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32627
* libgfortran/intrinsics/iso_c_generated_procs.c: Add c_f_pointer
for character/string arguments.
* libgfortran/gfortran.map: Add c_f_pointer_s0.
* libgfortran/mk-kinds-h.sh: Save smallest integer kind as default
character kind.
* libgfortran/intrinsics/iso_c_generated_procs.c: Add versions of
c_f_pointer for complex and logical types.
* libgfortran/gfortran.map: Add c_f_pointer versions for logical
and complex types.
2007-07-16 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32627
* gfortran.dg/pr32627_driver.c: Driver for pr32627.
* gfortran.dg/pr32627.f03: New test case.
* gfortran.dg/c_f_pointer_logical.f03: New test case.
* gfortran.dg/c_f_pointer_logical_driver.c: Driver for
c_f_pointer_logical.
* gfortran.dg/c_f_pointer_complex_driver.c: Driver for
c_f_pointer_complex.
* gfortran.dg/c_f_pointer_complex.f03: New test case.
-------------- next part --------------
Index: gcc/testsuite/gfortran.dg/pr32627_driver.c
===================================================================
--- gcc/testsuite/gfortran.dg/pr32627_driver.c (revision 0)
+++ gcc/testsuite/gfortran.dg/pr32627_driver.c (revision 0)
@@ -0,0 +1,4 @@
+char *get_c_string()
+{
+ return "c_string";
+}
Index: gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03 (revision 0)
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_logical_driver.c }
+! Verify that c_f_pointer exists for C logicals (_Bool).
+module c_f_pointer_logical
+ use, intrinsic :: iso_c_binding, only: c_bool, c_f_pointer, c_ptr, c_int
+contains
+ subroutine test_scalar(c_logical_ptr) bind(c)
+ type(c_ptr), value :: c_logical_ptr
+ logical(c_bool), pointer :: f03_logical_ptr
+ call c_f_pointer(c_logical_ptr, f03_logical_ptr)
+
+ if(f03_logical_ptr .neqv. .true.) call abort ()
+ end subroutine test_scalar
+
+ subroutine test_array(c_logical_array, num_elems) bind(c)
+ type(c_ptr), value :: c_logical_array
+ integer(c_int), value :: num_elems
+ logical(c_bool), pointer, dimension(:) :: f03_logical_array
+ integer :: i
+
+ call c_f_pointer(c_logical_array, f03_logical_array, (/ num_elems /))
+
+ ! Odd numbered locations are true (even numbered offsets in C)
+ do i = 1, num_elems, 2
+ if(f03_logical_array(i) .neqv. .true.) call abort ()
+ end do
+
+ ! Even numbered locations are false.
+ do i = 2, num_elems, 2
+ if(f03_logical_array(i) .neqv. .false.) call abort ()
+ end do
+ end subroutine test_array
+end module c_f_pointer_logical
+! { dg-final { cleanup-modules "c_f_pointer_logical" } }
Index: gcc/testsuite/gfortran.dg/pr32627.f03
===================================================================
--- gcc/testsuite/gfortran.dg/pr32627.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/pr32627.f03 (revision 0)
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-additional-sources pr32627_driver.c }
+! Verify that c_f_pointer exists for string arguments.
+program main
+ use iso_c_binding
+ implicit none
+ interface
+ function get_c_string() bind(c)
+ use, intrinsic :: iso_c_binding, only: c_ptr
+ type(c_ptr) :: get_c_string
+ end function get_c_string
+ end interface
+
+ type, bind( c ) :: A
+ integer( c_int ) :: xc, yc
+ type( c_ptr ) :: str
+ end type
+ type( c_ptr ) :: x
+ type( A ), pointer :: fptr
+ type( A ), target :: my_a_type
+ character( len=9 ), pointer :: strptr
+
+ fptr => my_a_type
+
+ fptr%str = get_c_string()
+
+ call c_f_pointer( fptr%str, strptr )
+
+ print *, 'strptr is: ', strptr
+end program main
+
+
Index: gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c
===================================================================
--- gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c (revision 0)
+++ gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c (revision 0)
@@ -0,0 +1,41 @@
+/* { dg-options "-std=c99 -w" } */
+/* From c_by_val.c in gfortran.dg. */
+#define _Complex_I (1.0iF)
+
+#define NUM_ELEMS 10
+
+void test_complex_scalars (float _Complex *float_complex_ptr,
+ double _Complex *double_complex_ptr,
+ long double _Complex *long_double_complex_ptr);
+void test_complex_arrays (float _Complex *float_complex_array,
+ double _Complex *double_complex_array,
+ long double _Complex *long_double_complex_array,
+ int num_elems);
+
+int main (int argc, char **argv)
+{
+ float _Complex c1;
+ double _Complex c2;
+ long double _Complex c3;
+ float _Complex c1_array[NUM_ELEMS];
+ double _Complex c2_array[NUM_ELEMS];
+ long double _Complex c3_array[NUM_ELEMS];
+ int i;
+
+ c1 = 1.0 + 0.0 * _Complex_I;
+ c2 = 2.0 + 0.0 * _Complex_I;
+ c3 = 3.0 + 0.0 * _Complex_I;
+
+ test_complex_scalars (&c1, &c2, &c3);
+
+ for (i = 0; i < NUM_ELEMS; i++)
+ {
+ c1_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
+ c2_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
+ c3_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
+ }
+
+ test_complex_arrays (c1_array, c2_array, c3_array, NUM_ELEMS);
+
+ return 0;
+}
Index: gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 (revision 0)
@@ -0,0 +1,61 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_complex_driver.c }
+! { dg-options "-std=gnu -w" }
+! Test c_f_pointer for the different types of interoperable complex values.
+module c_f_pointer_complex
+ use, intrinsic :: iso_c_binding, only: c_float_complex, c_double_complex, &
+ c_long_double_complex, c_f_pointer, c_ptr, c_long_double, c_int
+ implicit none
+
+contains
+ subroutine test_complex_scalars(my_c_float_complex, my_c_double_complex, &
+ my_c_long_double_complex) bind(c)
+ type(c_ptr), value :: my_c_float_complex
+ type(c_ptr), value :: my_c_double_complex
+ type(c_ptr), value :: my_c_long_double_complex
+ complex(c_float_complex), pointer :: my_f03_float_complex
+ complex(c_double_complex), pointer :: my_f03_double_complex
+ complex(c_long_double_complex), pointer :: my_f03_long_double_complex
+
+ call c_f_pointer(my_c_float_complex, my_f03_float_complex)
+ call c_f_pointer(my_c_double_complex, my_f03_double_complex)
+ call c_f_pointer(my_c_long_double_complex, my_f03_long_double_complex)
+
+ if(my_f03_float_complex /= (1.0, 0.0)) call abort ()
+ if(my_f03_double_complex /= (2.0d0, 0.0d0)) call abort ()
+ if(my_f03_long_double_complex /= (3.0_c_long_double, &
+ 0.0_c_long_double)) call abort ()
+ end subroutine test_complex_scalars
+
+ subroutine test_complex_arrays(float_complex_array, double_complex_array, &
+ long_double_complex_array, num_elems) bind(c)
+ type(c_ptr), value :: float_complex_array
+ type(c_ptr), value :: double_complex_array
+ type(c_ptr), value :: long_double_complex_array
+ complex(c_float_complex), pointer, dimension(:) :: f03_float_complex_array
+ complex(c_double_complex), pointer, dimension(:) :: &
+ f03_double_complex_array
+ complex(c_long_double_complex), pointer, dimension(:) :: &
+ f03_long_double_complex_array
+ integer(c_int), value :: num_elems
+ integer :: i
+
+ call c_f_pointer(float_complex_array, f03_float_complex_array, &
+ (/ num_elems /))
+ call c_f_pointer(double_complex_array, f03_double_complex_array, &
+ (/ num_elems /))
+ call c_f_pointer(long_double_complex_array, &
+ f03_long_double_complex_array, (/ num_elems /))
+
+ do i = 1, num_elems
+ if(f03_float_complex_array(i) &
+ /= (i*(1.0, 0.0))) call abort ()
+ if(f03_double_complex_array(i) &
+ /= (i*(1.0d0, 0.0d0))) call abort ()
+ if(f03_long_double_complex_array(i) &
+ /= (i*(1.0_c_long_double, 0.0_c_long_double))) call abort ()
+ end do
+ end subroutine test_complex_arrays
+end module c_f_pointer_complex
+! { dg-final { cleanup-modules "c_f_pointer_complex" } }
+
Index: gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c
===================================================================
--- gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c (revision 0)
+++ gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c (revision 0)
@@ -0,0 +1,26 @@
+/* { dg-options "-std=c99 -w" } */
+
+#include <stdbool.h>
+
+#define NUM_ELEMS 10
+
+void test_scalar(_Bool *my_c_bool_ptr);
+void test_array(_Bool *my_bool_array, int num_elems);
+
+int main(int argc, char **argv)
+{
+ _Bool my_bool = true;
+ _Bool my_bool_array[NUM_ELEMS];
+ int i;
+
+ test_scalar(&my_bool);
+
+ for(i = 0; i < NUM_ELEMS; i+=2)
+ my_bool_array[i] = true;
+ for(i = 1; i < NUM_ELEMS; i+=2)
+ my_bool_array[i] = false;
+
+ test_array(my_bool_array, NUM_ELEMS);
+
+ return 0;
+}
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 126682)
+++ gcc/fortran/resolve.c (working copy)
@@ -2248,6 +2248,11 @@ set_name_and_label (gfc_code *c, gfc_sym
type = gfc_type_letter (arg->ts.type);
kind = arg->ts.kind;
}
+
+ if (arg->ts.type == BT_CHARACTER)
+ /* Kind info for character strings not needed. */
+ kind = 0;
+
sprintf (name, "%s_%c%d", sym->name, type, kind);
/* Set up the binding label as the given symbol's label plus
the type and kind. */
Index: libgfortran/intrinsics/iso_c_generated_procs.c
===================================================================
--- libgfortran/intrinsics/iso_c_generated_procs.c (revision 126682)
+++ libgfortran/intrinsics/iso_c_generated_procs.c (working copy)
@@ -75,11 +75,57 @@ void ISO_C_BINDING_PREFIX (c_f_pointer_r
void ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *, gfc_array_void *,
const array_t *);
#endif
+
#ifdef HAVE_GFC_REAL_16
void ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *, gfc_array_void *,
const array_t *);
#endif
+#ifdef HAVE_GFC_COMPLEX_4
+void ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_COMPLEX_8
+void ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_COMPLEX_10
+void ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_COMPLEX_16
+void ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef GFC_DEFAULT_CHAR
+void ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_LOGICAL_1
+void ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_LOGICAL_2
+void ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_LOGICAL_4
+void ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
+#ifdef HAVE_GFC_LOGICAL_8
+void ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *, gfc_array_void *,
+ const array_t *);
+#endif
+
#ifdef HAVE_GFC_INTEGER_1
/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C
@@ -262,3 +308,164 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r16) (
(int) sizeof (GFC_REAL_16));
}
#endif
+
+
+#ifdef HAVE_GFC_COMPLEX_4
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type complex and
+ kind=4. The function c_f_pointer is used to set up the pointer
+ descriptor. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have an complex(kind=4). */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_COMPLEX,
+ (int) sizeof (GFC_COMPLEX_4));
+}
+#endif
+
+
+#ifdef HAVE_GFC_COMPLEX_8
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type complex and
+ kind=8. The function c_f_pointer is used to set up the pointer
+ descriptor. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have an complex(kind=8). */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_COMPLEX,
+ (int) sizeof (GFC_COMPLEX_8));
+}
+#endif
+
+
+#ifdef HAVE_GFC_COMPLEX_10
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type complex and
+ kind=10. The function c_f_pointer is used to set up the pointer
+ descriptor. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have an complex(kind=10). */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_COMPLEX,
+ (int) sizeof (GFC_COMPLEX_10));
+}
+#endif
+
+
+#ifdef HAVE_GFC_COMPLEX_16
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type complex and
+ kind=16. The function c_f_pointer is used to set up the pointer
+ descriptor. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have an complex(kind=16). */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_COMPLEX,
+ (int) sizeof (GFC_COMPLEX_16));
+}
+#endif
+
+
+#ifdef GFC_DEFAULT_CHAR
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type character. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have a character string of len=1. */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_CHARACTER,
+ (int) sizeof (char));
+}
+#endif
+
+
+#ifdef HAVE_GFC_LOGICAL_1
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type logical, kind=1. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have a logical of kind=1. */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_LOGICAL,
+ (int) sizeof (GFC_LOGICAL_1));
+}
+#endif
+
+
+#ifdef HAVE_GFC_LOGICAL_2
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type logical, kind=2. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have a logical of kind=2. */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_LOGICAL,
+ (int) sizeof (GFC_LOGICAL_2));
+}
+#endif
+
+
+#ifdef HAVE_GFC_LOGICAL_4
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type logical, kind=4. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have a logical of kind=4. */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_LOGICAL,
+ (int) sizeof (GFC_LOGICAL_4));
+}
+#endif
+
+
+#ifdef HAVE_GFC_LOGICAL_8
+/* Set the given Fortran pointer, f_ptr_out, to point to the given C
+ address, c_ptr_in. The Fortran pointer is of type logical, kind=8. */
+
+void
+ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *c_ptr_in,
+ gfc_array_void *f_ptr_out,
+ const array_t *shape)
+{
+ /* Here we have a logical of kind=8. */
+ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
+ (int) GFC_DTYPE_LOGICAL,
+ (int) sizeof (GFC_LOGICAL_8));
+}
+#endif
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map (revision 126682)
+++ libgfortran/gfortran.map (working copy)
@@ -1016,6 +1016,15 @@ GFORTRAN_1.0 {
__iso_c_binding_c_f_pointer_r8;
__iso_c_binding_c_f_pointer_r10;
__iso_c_binding_c_f_pointer_r16;
+ __iso_c_binding_c_f_pointer_c4;
+ __iso_c_binding_c_f_pointer_c8;
+ __iso_c_binding_c_f_pointer_c10;
+ __iso_c_binding_c_f_pointer_c16;
+ __iso_c_binding_c_f_pointer_s0;
+ __iso_c_binding_c_f_pointer_l1;
+ __iso_c_binding_c_f_pointer_l2;
+ __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;
__iso_c_binding_c_funloc;
Index: libgfortran/mk-kinds-h.sh
===================================================================
--- libgfortran/mk-kinds-h.sh (revision 126682)
+++ libgfortran/mk-kinds-h.sh (working copy)
@@ -8,6 +8,7 @@ possible_real_kinds="4 8 10 16"
largest=""
+smallest=""
for k in $possible_integer_kinds; do
echo " integer (kind=$k) :: i" > tmp$$.f90
echo " end" >> tmp$$.f90
@@ -21,6 +22,10 @@ for k in $possible_integer_kinds; do
prefix=""
fi
+ if [ "$smallest" = "" ]; then
+ smallest="$k"
+ fi
+
echo "typedef ${prefix}int${s}_t GFC_INTEGER_${k};"
echo "typedef ${prefix}uint${s}_t GFC_UINTEGER_${k};"
echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
@@ -32,6 +37,7 @@ done
echo "#define GFC_INTEGER_LARGEST GFC_INTEGER_${largest}"
echo "#define GFC_UINTEGER_LARGEST GFC_UINTEGER_${largest}"
+echo "#define GFC_DEFAULT_CHAR ${smallest}"
echo ""
More information about the Fortran
mailing list