1! { dg-do run }
2! Test the fix for PR47844, in which the stride in the function result
3! was ignored. Previously, the result was [1,3] at lines 15 and 16.
4!
5! Contributed by KePu  <Kdx1999@gmail.com>
6!
7PROGRAM test_pointer_value
8  IMPLICIT NONE
9  INTEGER, DIMENSION(10), TARGET :: array= [1,3,5,7,9,11,13,15,17,19]
10  INTEGER, dimension(2) :: array_fifth
11  INTEGER, POINTER, DIMENSION(:) :: ptr_array => NULL()
12  INTEGER, POINTER, DIMENSION(:) :: ptr_array_fifth => NULL()
13  ptr_array => array
14  array_fifth = every_fifth (ptr_array)
15  if (any (array_fifth .ne. [1,11])) call abort
16  if (any (every_fifth(ptr_array) .ne. [1,11])) call abort
17CONTAINS
18  FUNCTION every_fifth (ptr_array) RESULT (ptr_fifth)
19    IMPLICIT NONE
20    INTEGER, POINTER, DIMENSION(:) :: ptr_fifth
21    INTEGER, POINTER, DIMENSION(:), INTENT(in) :: ptr_array
22    INTEGER :: low
23    INTEGER :: high
24    low = LBOUND (ptr_array, 1)
25    high = UBOUND (ptr_array, 1)
26    ptr_fifth => ptr_array (low: high: 5)
27  END FUNCTION every_fifth
28END PROGRAM test_pointer_value
29