gcc/testsuite/gfortran.dg/type_to_class_5.f03

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR84074
   4 !
   5 ! Contributed by Vladimir Fuka  <vladimir.fuka@gmail.com>
   6 !
   7   type :: t
   8       integer :: n
   9   end type
  10
  11   type(t) :: array(4) = [t(1),t(2),t(3),t(4)]
  12
  13   call sub(array((/3,1/)), [3,1,0,0]) ! Does not increment any elements of 'array'.
  14   call sub(array(1:3:2), [1,3,0,0])
  15   call sub(array(3:1:-2), [4,2,0,0])
  16   call sub(array, [3,2,5,4])          ! Elements 1 and 3 should have been incremented twice.
  17
  18 contains
  19
  20   subroutine sub(a, iarray)
  21     class(t) :: a(:)
  22     integer :: iarray(4)
  23     integer :: i
  24     do i=1,size(a)
  25         if (a(i)%n .ne. iarray(i)) STOP 1
  26         a(i)%n = a(i)%n+1
  27     enddo
  28   end subroutine
  29 end program