re PR libfortran/40187 (c_f_pointer with stride in SHAPE)

2009-05-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/40187
	* intrinsics/iso_c_binding.c (c_f_pointer_u0):  Take care
	of stride in "shape" argument.

2009-05-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/40187
	* gfortran.dg/c_f_pointer_shape_tests_4.f03:  New file.
	* gfortran.dg/c_f_pointer_shape_tests_4_driver.c:  New file.

From-SVN: r147894

3 files changed, 167 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f42781b..3c08129 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-05-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/40187
+	* gfortran.dg/c_f_pointer_shape_tests_4.f03:  New file.
+	* gfortran.dg/c_f_pointer_shape_tests_4_driver.c:  New file.
+
 2009-05-26  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/40246
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03
new file mode 100644
index 0000000..89b8666
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03
@@ -0,0 +1,115 @@
+! { 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_4
+  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(3) :: shape
+    integer :: i,j
+    
+    shape(1) = num_rows
+    shape(2) = -3;
+    shape(3) = num_cols
+    call c_f_pointer(cPtr, myArrayPtr, shape(1:3:2)) 
+    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
+
+  subroutine test_mixed(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) :: shape1
+    integer(c_long_long), dimension(1) :: shape2
+    integer :: i
+
+    shape1(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape1) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+
+    nullify(myArrayPtr)
+    shape2(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape2) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_mixed
+end module c_f_pointer_shape_tests_4
+! { dg-final { cleanup-modules "c_f_pointer_shape_tests_4" } } 
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4_driver.c
new file mode 100644
index 0000000..1282beb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4_driver.c
@@ -0,0 +1,46 @@
+#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);
+void test_mixed(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);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_int and
+	  kind=c_long_long.  */
+  test_mixed(my_array, NUM_ELEMS);
+
+  return 0;
+}