1! { dg-do run }
2!
3! PR fortran/35721
4!
5! ASSOCIATED(ptr, trgt) should return true if
6! the same storage units (in the same order)
7! gfortran was returning false if the strips
8! were different but only one (the same!) element
9! was present.
10!
11! Contributed by Dick Hendrickson
12!
13      program try_mg0028
14      implicit none
15      real  tda2r(2,3)
16
17      call       mg0028(tda2r,  1,  2,  3)
18
19      CONTAINS
20
21      SUBROUTINE MG0028(TDA2R,nf1,nf2,nf3)
22      integer        ::  nf1,nf2,nf3
23      real, target   ::  TDA2R(NF2,NF3)
24      real, pointer  ::  TLA2L(:,:),TLA2L1(:,:)
25      logical LL(4)
26      TLA2L => TDA2R(NF2:NF1:-NF2,NF3:NF1:-NF2)
27      TLA2L1 => TLA2L
28      LL(1) = ASSOCIATED(TLA2L)
29      LL(2) = ASSOCIATED(TLA2L,TLA2L1)
30      LL(3) = ASSOCIATED(TLA2L,TDA2R)
31      LL(4) = ASSOCIATED(TLA2L1,TDA2R(2:2,3:1:-2))  !should be true
32
33      if (any(LL .neqv. (/ .true., .true., .false., .true./))) then
34        print *, LL
35        print *, shape(TLA2L1)
36        print *, shape(TDA2R(2:2,3:1:-2))
37        stop
38      endif
39
40      END SUBROUTINE
41      END PROGRAM
42