gcc/testsuite/gfortran.dg/type_to_class_4.f03

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR56691 comment #7 (and comment #0).
   4 !
   5 ! Reduced from the original of Marco Restelli  <mrestelli@gmail.com>
   6 ! by Janus Weil  <janus@gcc.gnu.org>
   7 !
   8 module m2
   9   implicit none
  10   type :: t_stv
  11     real :: f1
  12   end type
  13 contains
  14   subroutine lcb(y)
  15     class(t_stv), intent(in) :: y(:)
  16     integer :: k
  17     do k=1,size(y)
  18       if (int(y(k)%f1) .ne. k) STOP 1
  19     enddo
  20   end subroutine
  21 end module
  22
  23 program test
  24  use m2
  25  implicit none
  26
  27  type(t_stv), allocatable :: work(:)
  28
  29   allocate(work(4))
  30   work(:)%f1 = (/ 1.,2.,3.,4./)
  31
  32   call lcb(work)
  33   call lcb(work(:4)) ! Indexing used to be offset by 1.
  34
  35 end program