gcc/testsuite/gfortran.dg/pointer_assign_8.f90

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