re PR fortran/32627 ([ISO Bind C] Accept c_f_pointer for TYPE)

2007-07-21  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.
        (gfc_iso_c_sub_interface): Set the kind of the SHAPE formal arg to
        that of the actual SHAPE arg.
        * symbol.c (gen_shape_param): Initialize kind for SHAPE arg.

2007-07-21  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/intrinsic/iso_c_binding.c (c_f_pointer_u0): Allow
        the optional SHAPE arg to be any valid integer kind.
        * 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-21  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.
        * gfortran.dg/c_f_pointer_shape_tests_2_driver.c: Driver for
        c_f_pointer_shape_tests_2.
        * gfortran.dg/c_f_pointer_shape_tests_2.f03: New test case.

From-SVN: r126817

5 files changed, 259 insertions, 1 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 560e8bc..56c5fcd 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,18 @@
+2007-07-21  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/intrinsic/iso_c_binding.c (c_f_pointer_u0): Allow
+	the optional SHAPE arg to be any valid integer kind.
+	* 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-19  Christopher D. Rickett  <crickett@lanl.gov>
 
 	PR fortran/32600
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index f8d184a..f118bf3 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -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;
diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c
index d73a9ce..101cc4e0 100644
--- a/libgfortran/intrinsics/iso_c_binding.c
+++ b/libgfortran/intrinsics/iso_c_binding.c
@@ -109,7 +109,28 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in,
         {
           /* Lower bound is 1, as specified by the draft.  */
           f_ptr_out->dim[i].lbound = 1;
-          f_ptr_out->dim[i].ubound = ((int *) (shape->data))[i];
+          /* Have to allow for the SHAPE array to be any valid kind for
+             an INTEGER type.  */
+#ifdef HAVE_GFC_INTEGER_1
+	  if (GFC_DESCRIPTOR_SIZE (shape) == 1)
+	    f_ptr_out->dim[i].ubound = ((GFC_INTEGER_1 *) (shape->data))[i];
+#endif
+#ifdef HAVE_GFC_INTEGER_2
+	  if (GFC_DESCRIPTOR_SIZE (shape) == 2)
+	    f_ptr_out->dim[i].ubound = ((GFC_INTEGER_2 *) (shape->data))[i];
+#endif
+#ifdef HAVE_GFC_INTEGER_4
+	  if (GFC_DESCRIPTOR_SIZE (shape) == 4)
+	    f_ptr_out->dim[i].ubound = ((GFC_INTEGER_4 *) (shape->data))[i];
+#endif
+#ifdef HAVE_GFC_INTEGER_8
+	  if (GFC_DESCRIPTOR_SIZE (shape) == 8)
+	    f_ptr_out->dim[i].ubound = ((GFC_INTEGER_8 *) (shape->data))[i];
+#endif
+#ifdef HAVE_GFC_INTEGER_16
+	  if (GFC_DESCRIPTOR_SIZE (shape) == 16)
+	    f_ptr_out->dim[i].ubound = ((GFC_INTEGER_16 *) (shape->data))[i];
+#endif		
         }
 
       /* Set the offset and strides.
diff --git a/libgfortran/intrinsics/iso_c_generated_procs.c b/libgfortran/intrinsics/iso_c_generated_procs.c
index f60b264..aee0e57 100644
--- a/libgfortran/intrinsics/iso_c_generated_procs.c
+++ b/libgfortran/intrinsics/iso_c_generated_procs.c
@@ -75,11 +75,57 @@ void ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *, gfc_array_void *,
 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) (void *c_ptr_in,
 				      (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
diff --git a/libgfortran/mk-kinds-h.sh b/libgfortran/mk-kinds-h.sh
index 98328b6..ccd0738 100755
--- a/libgfortran/mk-kinds-h.sh
+++ b/libgfortran/mk-kinds-h.sh
@@ -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 ""