1! { dg-do run }
2!
3! PR fortran/57530
4!
5!
6! TYPE => CLASS pointer assignment for variables
7!
8module m
9  implicit none
10  type t
11    integer :: ii = 55
12  end type t
13contains
14  subroutine sub (tgt, tgt2)
15    class(t), target :: tgt, tgt2(:)
16    type(t), pointer :: ptr, ptr2(:), ptr3(:,:)
17
18    if (tgt%ii /= 43) call abort()
19    if (size (tgt2) /= 3) call abort()
20    if (any (tgt2(:)%ii /= [11,22,33])) call abort()
21
22    ptr => tgt  ! TYPE => CLASS
23    ptr2 => tgt2  ! TYPE => CLASS
24    ptr3(-3:-3,1:3) => tgt2  ! TYPE => CLASS
25
26    if (.not. associated(ptr)) call abort()
27    if (.not. associated(ptr2)) call abort()
28    if (.not. associated(ptr3)) call abort()
29    if (.not. associated(ptr,tgt)) call abort()
30    if (.not. associated(ptr2,tgt2)) call abort()
31    if (ptr%ii /= 43) call abort()
32    if (size (ptr2) /= 3) call abort()
33    if (size (ptr3) /= 3) call abort()
34    if (any (ptr2(:)%ii /= [11,22,33])) call abort()
35    if (any (shape (ptr3) /= [1,3])) call abort()
36    if (any (ptr3(-3,:)%ii /= [11,22,33])) call abort()
37  end subroutine sub
38end module m
39
40use m
41type(t), target :: x
42type(t), target :: y(3)
43x%ii = 43
44y(:)%ii = [11,22,33]
45call sub(x,y)
46end
47