gcc/testsuite/gfortran.dg/pointer_array_11.f90

! { dg-do run }
!
! Test the fix for PR91077 - both the original test and that in comment #4 of the PR.
!
! Contribute by Ygal Klein  <ygalklein@gmail.com>
!
program test
  implicit none
  call original
  call comment_4
contains
  subroutine original
    integer, parameter :: length = 9
    real(8), dimension(2) :: a, b
    integer :: i
    type point
       real(8) :: x
    end type point

    type stored
       type(point), dimension(:), allocatable :: np
    end type stored
    type(stored), dimension(:), pointer :: std =>null()
    allocate(std(1))
    allocate(std(1)%np(length))
    std(1)%np(1)%x = 0.3d0
    std(1)%np(2)%x = 0.3555d0
    std(1)%np(3)%x = 0.26782d0
    std(1)%np(4)%x = 0d0
    std(1)%np(5)%x = 1.555d0
    std(1)%np(6)%x = 7.3d0
    std(1)%np(7)%x = 7.8d0
    std(1)%np(8)%x = 6.3d0
    std(1)%np(9)%x = 5.5d0
!    do i = 1, 2
!       write(*, "('std(1)%np(',i1,')%x = ',1e22.14)") i, std(1)%np(i)%x
!    end do
!    do i = 1, 2
!       write(*, "('std(1)%np(1:',i1,') = ',9e22.14)") i, std(1)%np(1:i)%x
!    end do
    a = std(1)%np(1:2)%x
    b = [std(1)%np(1)%x, std(1)%np(2)%x]
!    print *,a
!    print *,b
    if (allocated (std(1)%np)) deallocate (std(1)%np)
    if (associated (std)) deallocate (std)
    if (norm2(a - b) .gt. 1d-3) stop 1
  end subroutine

  subroutine comment_4
    integer, parameter :: length = 2
    real(8), dimension(length) :: a, b
    integer :: i

    type point
       real(8) :: x
    end type point

    type points
       type(point), dimension(:), pointer :: np=>null()
    end type points

    type stored
       integer :: l
       type(points), pointer :: nfpoint=>null()
    end type stored

    type(stored), dimension(:), pointer :: std=>null()


    allocate(std(1))
    allocate(std(1)%nfpoint)
    allocate(std(1)%nfpoint%np(length))
    std(1)%nfpoint%np(1)%x = 0.3d0
    std(1)%nfpoint%np(2)%x = 0.3555d0

!    do i = 1, length
!       write(*, "('std(1)%nfpoint%np(',i1,')%x = ',1e22.14)") i, std(1)%nfpoint%np(i)%x
!    end do
!    do i = 1, length
!       write(*, "('std(1)%nfpoint%np(1:',i1,')%x = ',2e22.14)") i, std(1)%nfpoint%np(1:i)%x
!    end do
    a = std(1)%nfpoint%np(1:2)%x
    b = [std(1)%nfpoint%np(1)%x, std(1)%nfpoint%np(2)%x]
    if (associated (std(1)%nfpoint%np)) deallocate (std(1)%nfpoint%np)
    if (associated (std(1)%nfpoint)) deallocate (std(1)%nfpoint)
    if (associated (std)) deallocate (std)
    if (norm2(a - b) .gt. 1d-3) stop 2
    end subroutine
end program test