! PR 101310
! { dg-do run }
! { dg-additional-sources "section-3-c.c dump-descriptors.c" }
! { dg-additional-options "-g" }
!
! This program tests basic use of the CFI_section C library function to
! take a slice of a 2-dimensional pointer array.

module mm
  use ISO_C_BINDING
  type, bind (c) :: m
    integer(C_INT) :: x, y
  end type
end module

program testit
  use iso_c_binding
  use mm
  implicit none

  interface
    subroutine ctest (p, lb0, lb1, ub0, ub1, s0, s1, r) bind (c)
      use iso_c_binding
      use mm
      type(m), pointer :: p(:,:)
      integer(C_INT), value :: lb0, lb1, ub0, ub1, s0, s1
      type(m), pointer, intent(out) :: r(:)
    end subroutine

  end interface

  type(m), target :: aa(10, 20)
  integer :: i0, i1

  ! Initialize the test array by numbering its elements.
  do i1 = 1, 20
    do i0 = 1, 10
      aa(i0, i1)%x = i0
      aa(i0, i1)%y = i1
    end do
  end do

  ! Zero lower bound
  call test (aa, 0, 0, 2, 0, 2, 19, 0, 1)        ! full slice 0
  call test (aa, 0, 0, 0, 7, 9, 7, 1, 0)         ! full slice 1
  call test (aa, 0, 0, 2, 4, 2, 13, 0, 3)        ! partial slice 0
  call test (aa, 0, 0, 1, 7, 9, 7, 2, 0)         ! partial slice 1
  call test (aa, 0, 0, 2, 13, 2, 4, 0, -3)       ! backwards slice 0
  call test (aa, 0, 0, 9, 7, 1, 7, -2, 0)        ! backwards slice 1

  ! Lower bound 1
  call test (aa, 1, 1, 3, 1, 3, 20, 0, 1)        ! full slice 0
  call test (aa, 1, 1, 1, 8, 10, 8, 1, 0)        ! full slice 1
  call test (aa, 1, 1, 3, 5, 3, 14, 0, 3)        ! partial slice 0
  call test (aa, 1, 1, 2, 8, 10, 8, 2, 0)        ! partial slice 1
  call test (aa, 1, 1, 3, 14, 3, 5, 0, -3)       ! backwards slice 0
  call test (aa, 1, 1, 10, 8, 2, 8, -2, 0)       ! backwards slice 1

  ! Some other lower bound
  call test (aa, 2, 3, 4, 3, 4, 22, 0, 1)        ! full slice 0
  call test (aa, 2, 3, 2, 10, 11, 10, 1, 0)      ! full slice 1
  call test (aa, 2, 3, 4, 7, 4, 16, 0, 3)        ! partial slice 0
  call test (aa, 2, 3, 3, 10, 11, 10, 2, 0)      ! partial slice 1
  call test (aa, 2, 3, 4, 16, 4, 7, 0, -3)       ! backwards slice 0
  call test (aa, 2, 3, 11, 10, 3, 10, -2, 0)     ! backwards slice 1

contains

  subroutine test (aa, lo0, lo1, lb0, lb1, ub0, ub1, s0, s1)
    use mm
    type(m), target :: aa(10,20)
    integer :: lo0, lo1, lb0, lb1, ub0, ub1, s0, s1

    type(m), pointer :: pp(:,:), rr(:)
    integer :: i0, i1, o0, o1

    integer :: hi0, hi1
    hi0 = lo0 + 10 - 1
    hi1 = lo1 + 20 - 1

    ! Check the bounds actually specify a "slice" rather than a subarray.
    if (lb0 .ne. ub0 .and. lb1 .ne. ub1)  stop 100

    pp(lo0:,lo1:) => aa
    if (lbound (pp, 1) .ne. lo0) stop 121
    if (lbound (pp, 2) .ne. lo1) stop 121
    if (ubound (pp, 1) .ne. hi0) stop 122
    if (ubound (pp, 2) .ne. hi1) stop 122
    nullify (rr)
    call ctest (pp, lb0, lb1, ub0, ub1, s0, s1, rr)

    ! Make sure the input pointer array has not been modified.
    if (lbound (pp, 1) .ne. lo0) stop 131
    if (ubound (pp, 1) .ne. hi0) stop 132
    if (lbound (pp, 2) .ne. lo1) stop 133
    if (ubound (pp, 2) .ne. hi1) stop 134
    do i1 = lo1, hi1
      do i0 = lo0, hi0
        if (pp(i0,i1)%x .ne. i0 - lo0 + 1) stop 135
        if (pp(i0,i1)%y .ne. i1 - lo1 + 1) stop 136
      end do
    end do

    ! Make sure the output array has the expected bounds and elements.
    if (.not. associated (rr)) stop 111
    if (lbound (rr, 1) .ne. 1) stop 112
    if (ub0 .eq. lb0) then
      if (ubound (rr, 1) .ne. (ub1 - lb1)/s1 + 1) stop 113
      o1 = 1
      do i1 = lb1, ub1, s1
        if (rr(o1)%x .ne. lb0 - lo0 + 1) stop 114
        if (rr(o1)%y .ne. i1 - lo1 + 1) stop 114
	o1 = o1 + 1
      end do
    else
      if (ubound (rr, 1) .ne. (ub0 - lb0)/s0 + 1) stop 113
      o0 = 1
      do i0 = lb0, ub0, s0
        if (rr(o0)%x .ne. i0 - lo0 + 1) stop 114
        if (rr(o0)%y .ne. lb1 - lo1 + 1) stop 114
	o0 = o0 + 1
      end do
    end if
  end subroutine

end program