1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
! { 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
|
