Subversion Repositories openrisc_2011-10-31

! { dg-do run }
! { dg-additional-sources c_f_pointer_shape_tests_2_driver.c }
! Verify that the optional SHAPE parameter to c_f_pointer can be of any
! valid integer kind.  We don't test all kinds here since it would be 
! difficult to know what kinds are valid for the architecture we're running on.
! However, testing ones that should be different should be sufficient.
module c_f_pointer_shape_tests_2
  use, intrinsic :: iso_c_binding
  implicit none
contains
  subroutine test_long_long_1d(cPtr, num_elems) bind(c)
    use, intrinsic :: iso_c_binding
    type(c_ptr), value :: cPtr
    integer(c_int), value :: num_elems
    integer, dimension(:), pointer :: myArrayPtr
    integer(c_long_long), dimension(1) :: shape
    integer :: i
    
    shape(1) = num_elems
    call c_f_pointer(cPtr, myArrayPtr, shape) 
    do i = 1, num_elems
       if(myArrayPtr(i) /= (i-1)) call abort ()
    end do
  end subroutine test_long_long_1d

  subroutine test_long_long_2d(cPtr, num_rows, num_cols) bind(c)
    use, intrinsic :: iso_c_binding
    type(c_ptr), value :: cPtr
    integer(c_int), value :: num_rows
    integer(c_int), value :: num_cols
    integer, dimension(:,:), pointer :: myArrayPtr
    integer(c_long_long), dimension(2) :: shape
    integer :: i,j
    
    shape(1) = num_rows
    shape(2) = num_cols
    call c_f_pointer(cPtr, myArrayPtr, shape) 
    do j = 1, num_cols
       do i = 1, num_rows
          if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) call abort ()
       end do
    end do
  end subroutine test_long_long_2d

  subroutine test_long_1d(cPtr, num_elems) bind(c)
    use, intrinsic :: iso_c_binding
    type(c_ptr), value :: cPtr
    integer(c_int), value :: num_elems
    integer, dimension(:), pointer :: myArrayPtr
    integer(c_long), dimension(1) :: shape
    integer :: i
    
    shape(1) = num_elems
    call c_f_pointer(cPtr, myArrayPtr, shape) 
    do i = 1, num_elems
       if(myArrayPtr(i) /= (i-1)) call abort ()
    end do
  end subroutine test_long_1d

  subroutine test_int_1d(cPtr, num_elems) bind(c)
    use, intrinsic :: iso_c_binding
    type(c_ptr), value :: cPtr
    integer(c_int), value :: num_elems
    integer, dimension(:), pointer :: myArrayPtr
    integer(c_int), dimension(1) :: shape
    integer :: i
    
    shape(1) = num_elems
    call c_f_pointer(cPtr, myArrayPtr, shape) 
    do i = 1, num_elems
       if(myArrayPtr(i) /= (i-1)) call abort ()
    end do
  end subroutine test_int_1d

  subroutine test_short_1d(cPtr, num_elems) bind(c)
    use, intrinsic :: iso_c_binding
    type(c_ptr), value :: cPtr
    integer(c_int), value :: num_elems
    integer, dimension(:), pointer :: myArrayPtr
    integer(c_short), dimension(1) :: shape
    integer :: i
    
    shape(1) = num_elems
    call c_f_pointer(cPtr, myArrayPtr, shape) 
    do i = 1, num_elems
       if(myArrayPtr(i) /= (i-1)) call abort ()
    end do
  end subroutine test_short_1d

  subroutine test_mixed(cPtr, num_elems) bind(c)
    use, intrinsic :: iso_c_binding
    type(c_ptr), value :: cPtr
    integer(c_int), value :: num_elems
    integer, dimension(:), pointer :: myArrayPtr
    integer(c_int), dimension(1) :: shape1
    integer(c_long_long), dimension(1) :: shape2
    integer :: i

    shape1(1) = num_elems
    call c_f_pointer(cPtr, myArrayPtr, shape1) 
    do i = 1, num_elems
       if(myArrayPtr(i) /= (i-1)) call abort ()
    end do

    nullify(myArrayPtr)
    shape2(1) = num_elems
    call c_f_pointer(cPtr, myArrayPtr, shape2) 
    do i = 1, num_elems
       if(myArrayPtr(i) /= (i-1)) call abort ()
    end do
  end subroutine test_mixed
end module c_f_pointer_shape_tests_2
! { dg-final { cleanup-modules "c_f_pointer_shape_tests_2" } }