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