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.
7module c_f_pointer_shape_tests_2
8  use, intrinsic :: iso_c_binding
9  implicit none
10contains
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(c_int), 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)) STOP 1
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(c_int), dimension(:,:), pointer :: myArrayPtr
32    integer(c_long_long), dimension(2) :: shape
33    integer :: i,j
34
35    shape(1) = num_rows
36    shape(2) = num_cols
37    call c_f_pointer(cPtr, myArrayPtr, shape)
38    do j = 1, num_cols
39       do i = 1, num_rows
40          if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) STOP 2
41       end do
42    end do
43  end subroutine test_long_long_2d
44
45  subroutine test_long_1d(cPtr, num_elems) bind(c)
46    use, intrinsic :: iso_c_binding
47    type(c_ptr), value :: cPtr
48    integer(c_int), value :: num_elems
49    integer(c_int), dimension(:), pointer :: myArrayPtr
50    integer(c_long), dimension(1) :: shape
51    integer :: i
52
53    shape(1) = num_elems
54    call c_f_pointer(cPtr, myArrayPtr, shape)
55    do i = 1, num_elems
56       if(myArrayPtr(i) /= (i-1)) STOP 3
57    end do
58  end subroutine test_long_1d
59
60  subroutine test_int_1d(cPtr, num_elems) bind(c)
61    use, intrinsic :: iso_c_binding
62    type(c_ptr), value :: cPtr
63    integer(c_int), value :: num_elems
64    integer(c_int), dimension(:), pointer :: myArrayPtr
65    integer(c_int), dimension(1) :: shape
66    integer :: i
67
68    shape(1) = num_elems
69    call c_f_pointer(cPtr, myArrayPtr, shape)
70    do i = 1, num_elems
71       if(myArrayPtr(i) /= (i-1)) STOP 4
72    end do
73  end subroutine test_int_1d
74
75  subroutine test_short_1d(cPtr, num_elems) bind(c)
76    use, intrinsic :: iso_c_binding
77    type(c_ptr), value :: cPtr
78    integer(c_int), value :: num_elems
79    integer(c_int), dimension(:), pointer :: myArrayPtr
80    integer(c_short), dimension(1) :: shape
81    integer :: i
82
83    shape(1) = num_elems
84    call c_f_pointer(cPtr, myArrayPtr, shape)
85    do i = 1, num_elems
86       if(myArrayPtr(i) /= (i-1)) STOP 5
87    end do
88  end subroutine test_short_1d
89
90  subroutine test_mixed(cPtr, num_elems) bind(c)
91    use, intrinsic :: iso_c_binding
92    type(c_ptr), value :: cPtr
93    integer(c_int), value :: num_elems
94    integer(c_int), dimension(:), pointer :: myArrayPtr
95    integer(c_int), dimension(1) :: shape1
96    integer(c_long_long), dimension(1) :: shape2
97    integer :: i
98
99    shape1(1) = num_elems
100    call c_f_pointer(cPtr, myArrayPtr, shape1)
101    do i = 1, num_elems
102       if(myArrayPtr(i) /= (i-1)) STOP 6
103    end do
104
105    nullify(myArrayPtr)
106    shape2(1) = num_elems
107    call c_f_pointer(cPtr, myArrayPtr, shape2)
108    do i = 1, num_elems
109       if(myArrayPtr(i) /= (i-1)) STOP 7
110    end do
111  end subroutine test_mixed
112end module c_f_pointer_shape_tests_2
113