gcc/testsuite/gfortran.dg/pointer_function_result_1.f90

   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 !
   7 PROGRAM 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
  17 CONTAINS
  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
  28 END PROGRAM test_pointer_value