1! { dg-do run }
2! Tests the fix for PR31204, in which 'i' below would be incorrectly
3! host associated by the contained subroutines.  The checks for 'ii'
4! and 'iii' have been added, since they can be host associated because
5! of the explicit declarations in the main program.
6!
7! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
8!
9  integer ii
10  INTEGER, PARAMETER :: jmin(1:10) = (/ (i, i = 1, 10) /)
11  INTEGER, PARAMETER :: kmin(1:10) = (/ (ii, ii = 1, 10) /)
12  INTEGER, PARAMETER :: lmin(1:10) = (/ (iii, iii = 1, 10) /)
13  integer iii
14  CALL two
15
16CONTAINS
17
18  SUBROUTINE one
19    i = 99
20    ii = 99
21    iii = 999
22  END SUBROUTINE
23
24  SUBROUTINE two
25    i = 0
26    ii = 0
27    iii = 0
28    CALL one
29    IF (i .NE. 0) STOP 1
30    IF (ii .NE. 99) STOP 2
31    IF (iii .NE. 999) STOP 3
32  END SUBROUTINE
33END
34
35