Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/pointer_function_result_1.f90 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 ! Test the fix for PR47844, in which the stride in the function result
kono
parents:
diff changeset
3 ! was ignored. Previously, the result was [1,3] at lines 15 and 16.
kono
parents:
diff changeset
4 !
kono
parents:
diff changeset
5 ! Contributed by KePu <Kdx1999@gmail.com>
kono
parents:
diff changeset
6 !
kono
parents:
diff changeset
7 PROGRAM test_pointer_value
kono
parents:
diff changeset
8 IMPLICIT NONE
kono
parents:
diff changeset
9 INTEGER, DIMENSION(10), TARGET :: array= [1,3,5,7,9,11,13,15,17,19]
kono
parents:
diff changeset
10 INTEGER, dimension(2) :: array_fifth
kono
parents:
diff changeset
11 INTEGER, POINTER, DIMENSION(:) :: ptr_array => NULL()
kono
parents:
diff changeset
12 INTEGER, POINTER, DIMENSION(:) :: ptr_array_fifth => NULL()
kono
parents:
diff changeset
13 ptr_array => array
kono
parents:
diff changeset
14 array_fifth = every_fifth (ptr_array)
kono
parents:
diff changeset
15 if (any (array_fifth .ne. [1,11])) call abort
kono
parents:
diff changeset
16 if (any (every_fifth(ptr_array) .ne. [1,11])) call abort
kono
parents:
diff changeset
17 CONTAINS
kono
parents:
diff changeset
18 FUNCTION every_fifth (ptr_array) RESULT (ptr_fifth)
kono
parents:
diff changeset
19 IMPLICIT NONE
kono
parents:
diff changeset
20 INTEGER, POINTER, DIMENSION(:) :: ptr_fifth
kono
parents:
diff changeset
21 INTEGER, POINTER, DIMENSION(:), INTENT(in) :: ptr_array
kono
parents:
diff changeset
22 INTEGER :: low
kono
parents:
diff changeset
23 INTEGER :: high
kono
parents:
diff changeset
24 low = LBOUND (ptr_array, 1)
kono
parents:
diff changeset
25 high = UBOUND (ptr_array, 1)
kono
parents:
diff changeset
26 ptr_fifth => ptr_array (low: high: 5)
kono
parents:
diff changeset
27 END FUNCTION every_fifth
kono
parents:
diff changeset
28 END PROGRAM test_pointer_value