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