gcc/testsuite/gfortran.dg/pointer_array_component_3.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR88685, in which the component array references in 'doit'
   4 ! were being ascribed to the class pointer 'Cls' itself so that the stride
   5 ! measure between elements was wrong.
   6 !
   7 ! Contributed by Antony Lewis  <antony@cosmologist.info>
   8 !
   9 program tester
  10   implicit none
  11   Type TArr
  12     integer, allocatable :: CL(:)
  13   end Type TArr
  14
  15   type(TArr), allocatable, target :: arr(:,:)
  16   class(TArr), pointer:: Cls(:,:)
  17   integer i
  18
  19   allocate(arr(1,1))
  20   allocate(arr(1,1)%CL(3))
  21   arr(1,1)%CL=-1
  22   cls => arr
  23   call doit(cls)
  24   if (any (arr(1,1)%cl .ne. [3,2,1])) stop 3
  25 contains
  26   subroutine doit(cls)
  27     class(TArr), pointer :: Cls(:,:)
  28
  29     cls(1,1)%CL(1) = 3
  30     cls(1,1)%CL(2:3) = [2,1]
  31
  32     if (any (Cls(1,1)%CL .ne. [3,2,1])) stop 1
  33     if (Cls(1,1)%CL(2) .ne. 2) stop 2
  34
  35   end subroutine doit
  36 end program tester