1! { dg-do run }
2!
3! Fixes PR37787 where the EQUIVALENCE between QLA1 and QLA2 wasn't recognized
4! in the dependency checking because the compiler was looking in the wrong name
5! space.
6!
7! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
8!
9module stuff
10  integer, parameter :: r4_kv = 4
11contains
12
13  SUBROUTINE CF0004
14!  COPYRIGHT 1999   SPACKMAN & HENDRICKSON, INC.
15    REAL(R4_KV), dimension (10) :: QLA1, QLA2, QLA3, &
16                                   QCA = (/(i, i= 1, 10)/)
17    EQUIVALENCE (QLA1, QLA2)
18    QLA1 = QCA
19    QLA3 = QCA
20    QLA3( 2:10:3) = QCA ( 1:5:2) + 1
21    QLA1( 2:10:3) = QLA2( 1:5:2) + 1  !failed because of dependency
22    if (any (qla1 .ne. qla3)) call abort
23  END SUBROUTINE
24end module
25
26program try_cf004
27  use stuff
28  nf1 = 1
29  nf2 = 2
30  call cf0004
31end
32