view gcc/testsuite/gfortran.dg/associate_18.f08 @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! { dg-do run }
!
! Contributed by Antony Lewis  <antony@cosmologist.info>
!                Andre Vehreschild  <vehre@gcc.gnu.org>
! Check that associating array-sections/scalars is working
! with class arrays.
!

program associate_18
  Type T
    integer :: map = 1
  end Type T

  class(T), allocatable :: av(:)
  class(T), allocatable :: am(:,:)
  class(T), pointer :: pv(:)
  class(T), pointer :: pm(:,:)

  integer :: iv(5) = 17
  integer :: im(4,5) = 23
  integer :: expect(20) = 23
  integer :: c

  allocate(av(2))
  associate(i => av(1))
    i%map = 2
  end associate
  if (any (av%map /= [2,1])) STOP 1
  deallocate(av)

  allocate(am(3,4))
  associate(pam => am(2:3, 2:3))
    pam%map = 7
    pam(1,2)%map = 8
  end associate
  if (any (reshape(am%map, [12]) /= [1,1,1, 1,7,7, 1,8,7, 1,1,1])) STOP 2
  deallocate(am)

  allocate(pv(2))
  associate(i => pv(1))
    i%map = 2
  end associate
  if (any (pv%map /= [2,1])) STOP 3
  deallocate(pv)

  allocate(pm(3,4))
  associate(ppm => pm(2:3, 2:3))
    ppm%map = 7
    ppm(1,2)%map = 8
  end associate
  if (any (reshape(pm%map, [12]) /= [1,1,1, 1,7,7, 1,8,7, 1,1,1])) STOP 4
  deallocate(pm)

  associate(i => iv(1))
    i = 7
  end associate
  if (any (iv /= [7, 17, 17, 17, 17])) STOP 5

  associate(pam => im(2:3, 2:3))
    pam = 9
    pam(1,2) = 10
    do c = 1, 2
        pam(2, c) = 0
    end do
  end associate
  if (any (reshape(im, [20]) /= [23,23,23,23, 23,9,0,23, &
        23,10,0,23, 23,23,23,23, 23,23,23,23])) STOP 6

  expect(2:3) = 9
  do c = 1, 5
    im = 23
    associate(pam => im(:, c))
      pam(2:3) = 9
    end associate
    if (any (reshape(im, [20]) /= expect)) STOP 7
    ! Shift expect
    expect = [expect(17:), expect(:16)]
  end do
end program