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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126817 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 229 insertions, 1 deletions

diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c
index d73a9ce93d7..101cc4e0039 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 f60b264dba6..aee0e57fef1 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