1! { dg-do run }
2!
3! Test the fix for PR91077 - both the original test and that in comment #4 of the PR.
4!
5! Contribute by Ygal Klein  <ygalklein@gmail.com>
6!
7program test
8  implicit none
9  call original
10  call comment_4
11contains
12  subroutine original
13    integer, parameter :: length = 9
14    real(8), dimension(2) :: a, b
15    integer :: i
16    type point
17       real(8) :: x
18    end type point
19
20    type stored
21       type(point), dimension(:), allocatable :: np
22    end type stored
23    type(stored), dimension(:), pointer :: std =>null()
24    allocate(std(1))
25    allocate(std(1)%np(length))
26    std(1)%np(1)%x = 0.3d0
27    std(1)%np(2)%x = 0.3555d0
28    std(1)%np(3)%x = 0.26782d0
29    std(1)%np(4)%x = 0d0
30    std(1)%np(5)%x = 1.555d0
31    std(1)%np(6)%x = 7.3d0
32    std(1)%np(7)%x = 7.8d0
33    std(1)%np(8)%x = 6.3d0
34    std(1)%np(9)%x = 5.5d0
35!    do i = 1, 2
36!       write(*, "('std(1)%np(',i1,')%x = ',1e22.14)") i, std(1)%np(i)%x
37!    end do
38!    do i = 1, 2
39!       write(*, "('std(1)%np(1:',i1,') = ',9e22.14)") i, std(1)%np(1:i)%x
40!    end do
41    a = std(1)%np(1:2)%x
42    b = [std(1)%np(1)%x, std(1)%np(2)%x]
43!    print *,a
44!    print *,b
45    if (allocated (std(1)%np)) deallocate (std(1)%np)
46    if (associated (std)) deallocate (std)
47    if (norm2(a - b) .gt. 1d-3) stop 1
48  end subroutine
49
50  subroutine comment_4
51    integer, parameter :: length = 2
52    real(8), dimension(length) :: a, b
53    integer :: i
54
55    type point
56       real(8) :: x
57    end type point
58
59    type points
60       type(point), dimension(:), pointer :: np=>null()
61    end type points
62
63    type stored
64       integer :: l
65       type(points), pointer :: nfpoint=>null()
66    end type stored
67
68    type(stored), dimension(:), pointer :: std=>null()
69
70
71    allocate(std(1))
72    allocate(std(1)%nfpoint)
73    allocate(std(1)%nfpoint%np(length))
74    std(1)%nfpoint%np(1)%x = 0.3d0
75    std(1)%nfpoint%np(2)%x = 0.3555d0
76
77!    do i = 1, length
78!       write(*, "('std(1)%nfpoint%np(',i1,')%x = ',1e22.14)") i, std(1)%nfpoint%np(i)%x
79!    end do
80!    do i = 1, length
81!       write(*, "('std(1)%nfpoint%np(1:',i1,')%x = ',2e22.14)") i, std(1)%nfpoint%np(1:i)%x
82!    end do
83    a = std(1)%nfpoint%np(1:2)%x
84    b = [std(1)%nfpoint%np(1)%x, std(1)%nfpoint%np(2)%x]
85    if (associated (std(1)%nfpoint%np)) deallocate (std(1)%nfpoint%np)
86    if (associated (std(1)%nfpoint)) deallocate (std(1)%nfpoint)
87    if (associated (std)) deallocate (std)
88    if (norm2(a - b) .gt. 1d-3) stop 2
89    end subroutine
90end program test
91