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