summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>2007-07-21 23:45:44 +0000
committerkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>2007-07-21 23:45:44 +0000
commit65a5a63e39b8eeb539b37435568fe615e1cd189f (patch)
treea0c66745a59e2ad6d40022ec11f867e11ccaa8fb
parentdd34543ef659eb4c3776cfb090eaa061ec3c1437 (diff)
downloadgcc-65a5a63e39b8eeb539b37435568fe615e1cd189f.tar.gz
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
-rw-r--r--gcc/fortran/ChangeLog9
-rw-r--r--gcc/fortran/resolve.c12
-rw-r--r--gcc/fortran/symbol.c3
-rw-r--r--gcc/testsuite/ChangeLog18
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_complex.f0361
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c41
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_logical.f0334
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c26
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f0391
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c41
-rw-r--r--gcc/testsuite/gfortran.dg/pr32627.f0332
-rw-r--r--gcc/testsuite/gfortran.dg/pr32627_driver.c4
-rw-r--r--libgfortran/ChangeLog15
-rw-r--r--libgfortran/gfortran.map9
-rw-r--r--libgfortran/intrinsics/iso_c_binding.c23
-rw-r--r--libgfortran/intrinsics/iso_c_generated_procs.c207
-rwxr-xr-xlibgfortran/mk-kinds-h.sh6
17 files changed, 630 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 87e5c6afa97..2e627da7a52 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,14 @@
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/32801
* symbol.c (generate_isocbinding_symbol): Remove unnecessary
conditional.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f50da8c95d8..45a49e2f0fd 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2282,6 +2282,11 @@ set_name_and_label (gfc_code *c, gfc_symbol *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. */
@@ -2356,6 +2361,13 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
/* the 1 means to add the optional arg to formal list */
new_sym = get_iso_c_sym (sym, name, binding_label, 1);
+ /* Set the kind for the SHAPE array to that of the actual
+ (if given). */
+ if (c->ext.actual != NULL && c->ext.actual->next != NULL
+ && c->ext.actual->next->expr->rank != 0)
+ new_sym->formal->next->next->sym->ts.kind =
+ c->ext.actual->next->next->expr->ts.kind;
+
/* for error reporting, say it's declared where the original was */
new_sym->declared_at = sym->declared_at;
}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index f8ca9b31df5..474de8e5564 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3421,6 +3421,9 @@ gen_shape_param (gfc_formal_arglist **head,
/* Integer array, rank 1, describing the shape of the object. */
param_sym->ts.type = BT_INTEGER;
+ /* Initialize the kind to default integer. However, it will be overriden
+ during resolution to match the kind of the SHAPE parameter given as
+ the actual argument (to allow for any valid integer kind). */
param_sym->ts.kind = gfc_default_integer_kind;
param_sym->as = gfc_get_array_spec ();
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b94b0e5cfed..17280f45a1a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,4 +1,20 @@
-2007-07-19 Christopher D. Rickett <crickett@lanl.gov>
+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.
+
+2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32804
* gfortran.dg/c_loc_tests_9.f03: New test case.
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03
new file mode 100644
index 00000000000..fd9703139e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03
@@ -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" } }
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c
new file mode 100644
index 00000000000..6286c341119
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c
@@ -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;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03
new file mode 100644
index 00000000000..977c4cb070d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c
new file mode 100644
index 00000000000..e3044c92e43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c
@@ -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;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03
new file mode 100644
index 00000000000..5d6acc2f574
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03
@@ -0,0 +1,91 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_shape_tests_2_driver.c }
+! Verify that the optional SHAPE parameter to c_f_pointer can be of any
+! valid integer kind. We don't test all kinds here since it would be
+! difficult to know what kinds are valid for the architecture we're running on.
+! However, testing ones that should be different should be sufficient.
+module c_f_pointer_shape_tests_2
+ use, intrinsic :: iso_c_binding
+ implicit none
+contains
+ subroutine test_long_long_1d(cPtr, num_elems) bind(c)
+ use, intrinsic :: iso_c_binding
+ type(c_ptr), value :: cPtr
+ integer(c_int), value :: num_elems
+ integer, dimension(:), pointer :: myArrayPtr
+ integer(c_long_long), dimension(1) :: shape
+ integer :: i
+
+ shape(1) = num_elems
+ call c_f_pointer(cPtr, myArrayPtr, shape)
+ do i = 1, num_elems
+ if(myArrayPtr(i) /= (i-1)) call abort ()
+ end do
+ end subroutine test_long_long_1d
+
+ subroutine test_long_long_2d(cPtr, num_rows, num_cols) bind(c)
+ use, intrinsic :: iso_c_binding
+ type(c_ptr), value :: cPtr
+ integer(c_int), value :: num_rows
+ integer(c_int), value :: num_cols
+ integer, dimension(:,:), pointer :: myArrayPtr
+ integer(c_long_long), dimension(2) :: shape
+ integer :: i,j
+
+ shape(1) = num_rows
+ shape(2) = num_cols
+ call c_f_pointer(cPtr, myArrayPtr, shape)
+ do j = 1, num_cols
+ do i = 1, num_rows
+ if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) call abort ()
+ end do
+ end do
+ end subroutine test_long_long_2d
+
+ subroutine test_long_1d(cPtr, num_elems) bind(c)
+ use, intrinsic :: iso_c_binding
+ type(c_ptr), value :: cPtr
+ integer(c_int), value :: num_elems
+ integer, dimension(:), pointer :: myArrayPtr
+ integer(c_long), dimension(1) :: shape
+ integer :: i
+
+ shape(1) = num_elems
+ call c_f_pointer(cPtr, myArrayPtr, shape)
+ do i = 1, num_elems
+ if(myArrayPtr(i) /= (i-1)) call abort ()
+ end do
+ end subroutine test_long_1d
+
+ subroutine test_int_1d(cPtr, num_elems) bind(c)
+ use, intrinsic :: iso_c_binding
+ type(c_ptr), value :: cPtr
+ integer(c_int), value :: num_elems
+ integer, dimension(:), pointer :: myArrayPtr
+ integer(c_int), dimension(1) :: shape
+ integer :: i
+
+ shape(1) = num_elems
+ call c_f_pointer(cPtr, myArrayPtr, shape)
+ do i = 1, num_elems
+ if(myArrayPtr(i) /= (i-1)) call abort ()
+ end do
+ end subroutine test_int_1d
+
+ subroutine test_short_1d(cPtr, num_elems) bind(c)
+ use, intrinsic :: iso_c_binding
+ type(c_ptr), value :: cPtr
+ integer(c_int), value :: num_elems
+ integer, dimension(:), pointer :: myArrayPtr
+ integer(c_short), dimension(1) :: shape
+ integer :: i
+
+ shape(1) = num_elems
+ call c_f_pointer(cPtr, myArrayPtr, shape)
+ do i = 1, num_elems
+ if(myArrayPtr(i) /= (i-1)) call abort ()
+ end do
+ end subroutine test_short_1d
+end module c_f_pointer_shape_tests_2
+! { dg-final { cleanup-modules "c_f_pointer_shape_tests_2" } }
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c
new file mode 100644
index 00000000000..686ae8fe289
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c
@@ -0,0 +1,41 @@
+#define NUM_ELEMS 10
+#define NUM_ROWS 2
+#define NUM_COLS 3
+
+void test_long_long_1d(int *array, int num_elems);
+void test_long_long_2d(int *array, int num_rows, int num_cols);
+void test_long_1d(int *array, int num_elems);
+void test_int_1d(int *array, int num_elems);
+void test_short_1d(int *array, int num_elems);
+
+int main(int argc, char **argv)
+{
+ int my_array[NUM_ELEMS];
+ int my_2d_array[NUM_ROWS][NUM_COLS];
+ int i, j;
+
+ for(i = 0; i < NUM_ELEMS; i++)
+ my_array[i] = i;
+
+ for(i = 0; i < NUM_ROWS; i++)
+ for(j = 0; j < NUM_COLS; j++)
+ my_2d_array[i][j] = (i*NUM_COLS) + j;
+
+ /* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long. */
+ test_long_long_1d(my_array, NUM_ELEMS);
+
+ /* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long.
+ The indices are transposed for Fortran. */
+ test_long_long_2d(my_2d_array[0], NUM_COLS, NUM_ROWS);
+
+ /* Test c_f_pointer where SHAPE is of type integer, kind=c_long. */
+ test_long_1d(my_array, NUM_ELEMS);
+
+ /* Test c_f_pointer where SHAPE is of type integer, kind=c_int. */
+ test_int_1d(my_array, NUM_ELEMS);
+
+ /* Test c_f_pointer where SHAPE is of type integer, kind=c_short. */
+ test_short_1d(my_array, NUM_ELEMS);
+
+ return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/pr32627.f03 b/gcc/testsuite/gfortran.dg/pr32627.f03
new file mode 100644
index 00000000000..f8695e00642
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32627.f03
@@ -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
+
+
diff --git a/gcc/testsuite/gfortran.dg/pr32627_driver.c b/gcc/testsuite/gfortran.dg/pr32627_driver.c
new file mode 100644
index 00000000000..24b7872ed6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32627_driver.c
@@ -0,0 +1,4 @@
+char *get_c_string()
+{
+ return "c_string";
+}
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 560e8bc5d94..56c5fcdcdbe 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 f8d184a5079..f118bf3277c 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 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
diff --git a/libgfortran/mk-kinds-h.sh b/libgfortran/mk-kinds-h.sh
index 98328b6323a..ccd073844c9 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 ""