gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03

   1 ! { dg-do run }
   2 ! { dg-additional-sources c_f_pointer_shape_tests_2_driver.c }
   3 ! Verify that the optional SHAPE parameter to c_f_pointer can be of any
   4 ! valid integer kind.  We don't test all kinds here since it would be
   5 ! difficult to know what kinds are valid for the architecture we're running on.
   6 ! However, testing ones that should be different should be sufficient.
   7 module c_f_pointer_shape_tests_4
   8   use, intrinsic :: iso_c_binding
   9   implicit none
  10 contains
  11   subroutine test_long_long_1d(cPtr, num_elems) bind(c)
  12     use, intrinsic :: iso_c_binding
  13     type(c_ptr), value :: cPtr
  14     integer(c_int), value :: num_elems
  15     integer, dimension(:), pointer :: myArrayPtr
  16     integer(c_long_long), dimension(1) :: shape
  17     integer :: i
  18
  19     shape(1) = num_elems
  20     call c_f_pointer(cPtr, myArrayPtr, shape)
  21     do i = 1, num_elems
  22        if(myArrayPtr(i) /= (i-1)) call abort ()
  23     end do
  24   end subroutine test_long_long_1d
  25
  26   subroutine test_long_long_2d(cPtr, num_rows, num_cols) bind(c)
  27     use, intrinsic :: iso_c_binding
  28     type(c_ptr), value :: cPtr
  29     integer(c_int), value :: num_rows
  30     integer(c_int), value :: num_cols
  31     integer, dimension(:,:), pointer :: myArrayPtr
  32     integer(c_long_long), dimension(3) :: shape
  33     integer :: i,j
  34
  35     shape(1) = num_rows
  36     shape(2) = -3;
  37     shape(3) = num_cols
  38     call c_f_pointer(cPtr, myArrayPtr, shape(1:3:2))
  39     do j = 1, num_cols
  40        do i = 1, num_rows
  41           if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) call abort ()
  42        end do
  43     end do
  44   end subroutine test_long_long_2d
  45
  46   subroutine test_long_1d(cPtr, num_elems) bind(c)
  47     use, intrinsic :: iso_c_binding
  48     type(c_ptr), value :: cPtr
  49     integer(c_int), value :: num_elems
  50     integer, dimension(:), pointer :: myArrayPtr
  51     integer(c_long), dimension(1) :: shape
  52     integer :: i
  53
  54     shape(1) = num_elems
  55     call c_f_pointer(cPtr, myArrayPtr, shape)
  56     do i = 1, num_elems
  57        if(myArrayPtr(i) /= (i-1)) call abort ()
  58     end do
  59   end subroutine test_long_1d
  60
  61   subroutine test_int_1d(cPtr, num_elems) bind(c)
  62     use, intrinsic :: iso_c_binding
  63     type(c_ptr), value :: cPtr
  64     integer(c_int), value :: num_elems
  65     integer, dimension(:), pointer :: myArrayPtr
  66     integer(c_int), dimension(1) :: shape
  67     integer :: i
  68
  69     shape(1) = num_elems
  70     call c_f_pointer(cPtr, myArrayPtr, shape)
  71     do i = 1, num_elems
  72        if(myArrayPtr(i) /= (i-1)) call abort ()
  73     end do
  74   end subroutine test_int_1d
  75
  76   subroutine test_short_1d(cPtr, num_elems) bind(c)
  77     use, intrinsic :: iso_c_binding
  78     type(c_ptr), value :: cPtr
  79     integer(c_int), value :: num_elems
  80     integer, dimension(:), pointer :: myArrayPtr
  81     integer(c_short), dimension(1) :: shape
  82     integer :: i
  83
  84     shape(1) = num_elems
  85     call c_f_pointer(cPtr, myArrayPtr, shape)
  86     do i = 1, num_elems
  87        if(myArrayPtr(i) /= (i-1)) call abort ()
  88     end do
  89   end subroutine test_short_1d
  90
  91   subroutine test_mixed(cPtr, num_elems) bind(c)
  92     use, intrinsic :: iso_c_binding
  93     type(c_ptr), value :: cPtr
  94     integer(c_int), value :: num_elems
  95     integer, dimension(:), pointer :: myArrayPtr
  96     integer(c_int), dimension(1) :: shape1
  97     integer(c_long_long), dimension(1) :: shape2
  98     integer :: i
  99
 100     shape1(1) = num_elems
 101     call c_f_pointer(cPtr, myArrayPtr, shape1)
 102     do i = 1, num_elems
 103        if(myArrayPtr(i) /= (i-1)) call abort ()
 104     end do
 105
 106     nullify(myArrayPtr)
 107     shape2(1) = num_elems
 108     call c_f_pointer(cPtr, myArrayPtr, shape2)
 109     do i = 1, num_elems
 110        if(myArrayPtr(i) /= (i-1)) call abort ()
 111     end do
 112   end subroutine test_mixed
 113 end module c_f_pointer_shape_tests_4
 114 ! { dg-final { cleanup-modules "c_f_pointer_shape_tests_4" } }
 115