blob: 8bb7ea158c9b80dd1258b94c8de2cfdfbb9a03d9 [file] [log] [blame]
 ! { dg-do run } ! PR fortran/101334 implicit none (type, external) real, target :: AT(10,10), BT real, contiguous, pointer :: A(:,:) real, pointer :: B real, pointer :: AP(:,:), BP real, pointer :: CP(:), DP(:,:), D, EP(:) call test_char() A => AT B => BT AP => A BP => B call foo(AP,B, A, 1) ! OK - associated call foo(BP,B, A, 2) ! OK - associated ! Those are all not associated: AP => null() BP => null() call foo(AP, B, A, 3) ! LHS not associated call foo(BP, B, A, 4) ! LHS not associated DP => null() D => null() call foo(AP, B, DP, 5) ! LHS+RHS not associated call foo(BP, D, A, 6) ! LHS+RHS not associated AP => A BP => B call foo(AP, B, DP, 7) ! RHS not associated call foo(BP, D, A, 8) ! RHS not associated CP(1:size(A)) => A call foo(CP, B, A, 9) ! Shape (rank) differs AP => A(2:,:) call foo(AP, B, A, 10) ! Shape differs AP => A(:,2:) call foo(AP, B, A, 11) ! Shape differs AP(10:,10:) => A call foo(AP, B, A, 12) ! OK - bounds different, shape same CP => AT(1:-1, 5) EP => AT(1:-1, 5) ! Case(i) + case(iv) call foo2(CP, EP) ! CP associated - but CP not associated with EP contains subroutine foo2(p, lpd) implicit none (type, external) real, pointer :: p(..) ! "pointer" real, pointer :: lpd(:) ! array "target" if (.not.associated(p)) stop 18 ! OK - associated if (associated(p, lpd)) stop 19 ! .. but for zero-sized array end subroutine foo(p, lp, lpd, cnt) implicit none (type, external) real, pointer :: p(..) ! "pointer" real, pointer :: lp ! scalar "target" real, pointer :: lpd(:,:) ! array "target" integer, value :: cnt if (cnt == 1) then if (.not. associated(p, lpd)) stop 1 ! OK elseif (cnt == 2) then if (.not. associated(p, lp)) stop 2 ! OK elseif (cnt == 3) then if (associated(p, lpd)) stop 3 ! LHS NULL ptr if (associated(p)) stop 4 ! LHS NULL ptr elseif (cnt == 4) then if (associated(p, lp)) stop 5 ! LHS NULL ptr if (associated(p)) stop 6 ! LHS NULL ptr elseif (cnt == 5) then if (associated(p, lpd)) stop 7 ! LHS+RHS NULL ptr if (associated(p)) stop 8 ! LHS+RHS NULL ptr elseif (cnt == 6) then if (associated(p, lp)) stop 9 ! LHS+RHS NULL ptr if (associated(p)) stop 10 ! LHS+RHS NULL ptr elseif (cnt == 7) then if (associated(p, lpd)) stop 11 ! RHS NULL ptr elseif (cnt == 8) then if (associated(p, lp)) stop 12 ! RHS NULL ptr elseif (cnt == 9) then if (associated(p, lpd)) stop 13 ! rank differs if (associated(p, lp)) stop 14 ! rank differs elseif (cnt == 10) then if (associated(p, lpd)) stop 15 ! shape differs elseif (cnt == 11) then if (associated(p, lpd)) stop 16 ! shape differs elseif (cnt == 12) then if (.not.associated(p, lpd)) stop 17 ! OK - shape same, lbound different else stop 99 endif end subroutine test_char() character(len=0), target :: str0 character(len=2), target :: str2 character(len=:), pointer :: ptr ptr => str0 call test_char2(ptr, str0) ptr => str2 call test_char2(ptr, str2) end subroutine test_char2(x,y) character(len=:), pointer :: x character(len=*), target :: y if (len(y) == 0) then if (len(x) /= 0) stop 20 if (.not. associated(x)) stop 21 if (associated(x, y)) stop 22 else if (len(y) /= 2) stop 23 if (len(x) /= 2) stop 24 if (.not. associated(x)) stop 25 if (.not. associated(x, y)) stop 26 end if end end