! { dg-do run }
! { dg-additional-options "-fdump-tree-original" }
!
! PR fortran/102043
! Array indexing was causing the middle-end to conclude the index
! to be non-negative, which can be wrong for arrays with a "reversed-order"
! descriptor.  This was fixed by using pointer arithmetic when
! the index can be negative.
! 
! This test checks the code generated for array references of various kinds
! of arrays, using either array indexing or pointer arithmetic.

program p
  implicit none
  call check_assumed_shape_elem
  call check_assumed_shape_scalarized
  call check_descriptor_dim
  call check_cfi_dim
  call check_substring
  call check_ptr_elem
  call check_ptr_scalarized
  call check_explicit_shape_elem
  call check_explicit_shape_scalarized
  call check_tmp_array
  call check_allocatable_array_elem
  call check_allocatable_array_scalarized
contains
  subroutine cases(assumed_shape_x)
    integer :: assumed_shape_x(:)
    assumed_shape_x(2) = 10
  end subroutine cases 
  subroutine check_assumed_shape_elem
    integer :: x(3)
    x = 0
    call cases(x)
    if (any(x /= (/ 0, 10, 0 /))) stop 10
    ! Assumed shape array are referenced with pointer arithmetic.
    ! { dg-final { scan-tree-dump-times "\\*\\(\\(integer\\(kind=4\\) \\*\\) assumed_shape_x.\\d+ \\+ \\(sizetype\\) \\(\\(stride.\\d+ \\* 2 \\+ offset.\\d+\\) \\* 4\\)\\) = 10;" 1 "original" } }
  end subroutine check_assumed_shape_elem
  subroutine casss(assumed_shape_y)
    integer :: assumed_shape_y(:)
    assumed_shape_y = 11
  end subroutine casss 
  subroutine check_assumed_shape_scalarized
    integer :: y(3)
    call casss(y)
    if (any(y /= 11)) stop 11
    ! Assumed shape array are referenced with pointer arithmetic.
    ! { dg-final { scan-tree-dump-times "\\*\\(\\(integer\\(kind=4\\) \\*\\) assumed_shape_y.\\d+ \\+ \\(sizetype\\) \\(\\(S.\\d+ \\* D.\\d+ \\+ D.\\d+\\) \\* 4\\)\\) = 11;" 1 "original" } }
  end subroutine check_assumed_shape_scalarized
  subroutine check_descriptor_dim
    integer, allocatable :: descriptor(:)
    allocate(descriptor(4))
    descriptor(:) = 12
    if (any(descriptor /= 12)) stop 12
    ! The descriptor’s dim array is referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "descriptor\\.dim\\\[0\\\]\\.ubound = 4;" 1 "original" } }
  end subroutine check_descriptor_dim
  subroutine ccfis(cfi_descriptor) bind(c)
    integer :: cfi_descriptor(:)
    cfi_descriptor = 13
  end subroutine ccfis 
  subroutine check_cfi_dim 
    integer :: x(5)
    call ccfis(x)
    if (any(x /= 13)) stop 13
    ! The cfi descriptor’s dim array is referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "cfi_descriptor->dim\\\[idx.\\d+\\\]\\.ubound = _cfi_descriptor->dim\\\[idx.\\d+\\\]\\.extent \\+ \\(cfi_descriptor->dim\\\[idx.\\d+\\\]\\.lbound \\+ -1\\);" 1 "original" } }
  end subroutine check_cfi_dim
  subroutine css(c) bind(c)
    character :: c
    c = 'k'
  end subroutine css
  subroutine check_substring
    character(5) :: x
    x = 'abcde'
    call css(x(3:3))
    if (x /= 'abkde') stop 14
    ! Substrings use array indexing
    ! { dg-final { scan-tree-dump-times "css \\(\\(character\\(kind=1\\)\\\[\\d+:\\d+\\\] \\*\\) &x\\\[3\\\].lb: \\d+ sz: \\d+.\\);" 1 "original" } }
  end subroutine check_substring
  subroutine check_ptr_elem
    integer, target :: x(7)
    integer, pointer :: ptr_x(:)
    x = 0
    ptr_x => x
    ptr_x(4) = 16
    if (any(ptr_x /= (/ 0, 0, 0, 16, 0, 0, 0 /))) stop 16
    ! pointers are referenced with pointer arithmetic.
    ! { dg-final { scan-tree-dump-times "\\*\\(integer\\(kind=4\\) \\*\\) \\(ptr_x\\.data \\+ \\(sizetype\\) \\(\\(ptr_x\\.offset \\+ ptr_x\\.dim\\\[0\\\]\\.stride \\* 4\\) \\* ptr_x\\.span\\)\\) = 16;" 1 "original" } }
  end subroutine check_ptr_elem
  subroutine check_ptr_scalarized
    integer, target :: y(8)
    integer, pointer :: ptr_y(:)
    y = 0
    ptr_y => y
    ptr_y = 17
    if (any(ptr_y /= 17)) stop 17
    ! pointers are referenced with pointer arithmetic.
    ! { dg-final { scan-tree-dump-times "\\*\\(\\(integer\\(kind=4\\) \\*\\) D.\\d+ \\+ \\(sizetype\\) \\(\\(S.\\d+ \\* D.\\d+ \\+ D.\\d+\\) \\* ptr_y\\.span\\)\\) = 17;" 1 "original" } }
  end subroutine check_ptr_scalarized
  subroutine check_explicit_shape_elem
    integer :: explicit_shape_x(9)
    explicit_shape_x = 0
    explicit_shape_x(5) = 18
    if (any(explicit_shape_x /= (/ 0, 0, 0, 0, 18, 0, 0, 0, 0 /))) stop 18
    ! Explicit shape arrays are referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "explicit_shape_x\\\[4\\\] = 18;" 1 "original" } }
  end subroutine check_explicit_shape_elem
  subroutine check_explicit_shape_scalarized
    integer :: explicit_shape_y(3)
    explicit_shape_y = 19
    if (any(explicit_shape_y /= 19)) stop 19
    ! Explicit shape arrays are referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "explicit_shape_y\\\[S.\\d+ \\+ -1\\\] = 19;" 1 "original" } }
  end subroutine check_explicit_shape_scalarized
  subroutine check_tmp_array
    integer :: non_tmp(6)
    non_tmp = 15
    non_tmp(2:5) = non_tmp(1:4) + non_tmp(3:6)
    if (any(non_tmp /= (/ 15, 30, 30, 30, 30, 15 /))) stop 15
    ! temporary arrays use array indexing
    ! { dg-final { scan-tree-dump-times "\\(*\\(integer\\(kind=4\\)\\\[4\\\] \\* restrict\\) atmp.\\d+\\.data\\)\\\[S.\\d+\\\] = non_tmp\\\[S.\\d+\\\] \\+ non_tmp\\\[S.\\d+ \\+ 2\\\];" 1 "original" } }
    ! { dg-final { scan-tree-dump-times "non_tmp\\\[S.\\d+ \\+ 1\\\] = \\(\\*\\(integer\\(kind=4\\)\\\[4\\\] \\* restrict\\) atmp.\\d+\\.data\\)\\\[S.\\d+\\\];" 1 "original" } }
  end subroutine check_tmp_array
  subroutine check_allocatable_array_elem
    integer, allocatable :: allocatable_x(:)
    allocate(allocatable_x(4),source=0)
    allocatable_x(2) = 20
    if (any(allocatable_x /= (/ 0, 20, 0, 0 /))) stop 20
    ! Allocatable arrays are referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "\\(\\*\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) allocatable_x\\.data\\)\\\[allocatable_x\\.offset \\+ 2\\\] = 20;" 1 "original" } }
  end subroutine check_allocatable_array_elem
  subroutine check_allocatable_array_scalarized
    integer, allocatable :: allocatable_y(:)
    allocate(allocatable_y(5),source=0)
    allocatable_y = 21
    if (any(allocatable_y /= 21)) stop 21
    ! Allocatable arrays are referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "\\(\\*D.\\d+\\)\\\[S.\\d+ \\+ \\D.\\d+\\\] = 21;" 1 "original" } }
  end subroutine check_allocatable_array_scalarized
  subroutine cares(assumed_rank_x)
    integer :: assumed_rank_x(..)
    select rank(rank_1_var_x => assumed_rank_x)
      rank(1)
        rank_1_var_x(3) = 22
    end select
  end subroutine cares 
  subroutine check_assumed_rank_elem
    integer :: x(6)
    x = 0
    call cares(x)
    if (any(x /= (/ 0, 0, 22, 0, 0, 0 /))) stop 22
    ! Assumed rank arrays are referenced with pointer arithmetic.
    ! { dg-final { scan-tree-dump-times "\\*\\(\\(integer\\(kind=4\\) \\*\\) __tmp_INTEGER_4_rank_1\\.data \\+ \\(sizetype\\) \\(\\(__tmp_INTEGER_4_rank_1\\.offset \\+ __tmp_INTEGER_4_rank_1\\.dim\\\[0\\\]\\.stride \\* 3\\) \\* 4\\)\\) = 22;" 1 "original" } }
  end subroutine check_assumed_rank_elem
  subroutine carss(assumed_rank_y)
    integer :: assumed_rank_y(..)
    select rank(rank_1_var_y => assumed_rank_y)
      rank(1)
        rank_1_var_y = 23
    end select
  end subroutine carss 
  subroutine check_assumed_rank_scalarized
    integer :: y(7)
    call carss(y)
    if (any(y /= 23)) stop 23
    ! Assumed rank arrays are referenced with pointer arithmetic.
    ! { dg-final { scan-tree-dump-times "\\*\\(\\(integer\\(kind=4\\) \\*\\) D.\\d+ \\+ \\(sizetype\\) \\(\\(S.\\d+ \\* D.\\d+ \\+ D.\\d+\\) \\* 4\\)\\) = 23;" 1 "original" } }
  end subroutine check_assumed_rank_scalarized
  subroutine casces(assumed_shape_cont_x)
    integer, dimension(:), contiguous :: assumed_shape_cont_x
    assumed_shape_cont_x(4) = 24
  end subroutine casces 
  subroutine check_assumed_shape_cont_elem
    integer :: x(8)
    x = 0
    call casces(x)
    if (any(x /= (/ 0, 0, 0, 24, 0, 0, 0, 0 /))) stop 24
    ! Contiguous assumed shape arrays are referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "\\(\\*assumed_shape_cont_x.\\d+\\)\\\[stride.\\d+ \\* 4 \\+ offset.\\d+\\\] = 24;" 1 "original" } }
  end subroutine check_assumed_shape_cont_elem
  subroutine cascss(assumed_shape_cont_y)
    integer, dimension(:), contiguous :: assumed_shape_cont_y
    assumed_shape_cont_y = 25
  end subroutine cascss 
  subroutine check_assumed_shape_cont_scalarized
    integer :: y(9)
    call cascss(y)
    if (any(y /= 25)) stop 25
    ! Contiguous assumed shape arrays are referenced with array indexing.
    ! { dg-final { scan-tree-dump-times "\\(\\*assumed_shape_cont_y.\\d+\\)\\\[S.\\d+ \\* D.\\d+ \\+ D.\\d+\\\] = 25;" 1 "original" } }
  end subroutine check_assumed_shape_cont_scalarized
end program p