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(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(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)) STOP 2 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(c_int), 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)) STOP 3 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(c_int), 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)) STOP 4 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(c_int), 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)) STOP 5 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(c_int), 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)) STOP 6 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)) STOP 7 111 end do 112 end subroutine test_mixed 113end module c_f_pointer_shape_tests_4 114