view gcc/testsuite/gfortran.dg/pr86328.f90 @ 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 }
!
! Test the fix for PR86328 in which temporaries were not being
! assigned for array component references.
!
! Contributed by Martin  <mscfd@gmx.net>
!
program ptr_alloc

   type :: t
      class(*), allocatable :: val
   end type

   type :: list
      type(t), dimension(:), pointer :: ll
   end type

   integer :: i
   type(list) :: a

   allocate(a%ll(1:2))
   do i = 1,2
      allocate(a%ll(i)%val, source=i)
   end do

   do i = 1,2
     call rrr(a, i)
   end do

   do i = 1,2
      deallocate(a%ll(i)%val)
   end do
   deallocate (a%ll)
contains

   subroutine rrr(a, i)
      type(list), intent(in) :: a
      class(*), allocatable :: c
      integer :: i

      allocate(c, source=a%ll(i)%val)
      select type (c)
        type is (integer)
          if (c .ne. i) stop 1
      end select

   end subroutine

end