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_4
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, 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
113end module c_f_pointer_shape_tests_4
114