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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
! { dg-do run }
! { dg-additional-options "-fdump-tree-original" }
!
! PR fortran/61831
! The deallocation of components of array constructor elements
! used to have the side effect of also deallocating some other
! variable's components from which they were copied.
program main
implicit none
integer, parameter :: n = 2
type :: string_t
character(LEN=1), dimension(:), allocatable :: chars
end type string_t
type :: string_container_t
type(string_t) :: comp
end type string_container_t
type :: string_array_container_t
type(string_t) :: comp(n)
end type string_array_container_t
type(string_t) :: prt_in, tmp, tmpa(n)
type(string_container_t) :: tmpc, tmpca(n)
type(string_array_container_t) :: tmpac, tmpaca(n)
integer :: i, j, k
do i=1,16
! Test without intermediary function
prt_in = string_t(["A"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "A")) call abort
deallocate (prt_in%chars)
! scalar elemental function
prt_in = string_t(["B"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "B")) call abort
tmp = new_prt_spec (prt_in)
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "B")) call abort
deallocate (prt_in%chars)
deallocate (tmp%chars)
! array elemental function with array constructor
prt_in = string_t(["C"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "C")) call abort
tmpa = new_prt_spec ([(prt_in, i=1,2)])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "C")) call abort
deallocate (prt_in%chars)
do j=1,n
deallocate (tmpa(j)%chars)
end do
! scalar elemental function with structure constructor
prt_in = string_t(["D"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "D")) call abort
tmpc = new_prt_spec2 (string_container_t(prt_in))
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "D")) call abort
deallocate (prt_in%chars)
deallocate(tmpc%comp%chars)
! array elemental function of an array constructor of structure constructors
prt_in = string_t(["E"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "E")) call abort
tmpca = new_prt_spec2 ([ (string_container_t(prt_in), i=1,2) ])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "E")) call abort
deallocate (prt_in%chars)
do j=1,n
deallocate (tmpca(j)%comp%chars)
end do
! scalar elemental function with a structure constructor and a nested array constructor
prt_in = string_t(["F"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "F")) call abort
tmpac = new_prt_spec3 (string_array_container_t([ (prt_in, i=1,2) ]))
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "F")) call abort
deallocate (prt_in%chars)
do j=1,n
deallocate (tmpac%comp(j)%chars)
end do
! array elemental function with an array constructor nested inside
! a structure constructor nested inside an array constructor
prt_in = string_t(["G"])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "G")) call abort
tmpaca = new_prt_spec3 ([ (string_array_container_t([ (prt_in, i=1,2) ]), j=1,2) ])
if (.not. allocated(prt_in%chars)) call abort
if (any(prt_in%chars .ne. "G")) call abort
deallocate (prt_in%chars)
do j=1,n
do k=1,n
deallocate (tmpaca(j)%comp(k)%chars)
end do
end do
end do
contains
elemental function new_prt_spec (name) result (prt_spec)
type(string_t), intent(in) :: name
type(string_t) :: prt_spec
prt_spec = name
end function new_prt_spec
elemental function new_prt_spec2 (name) result (prt_spec)
type(string_container_t), intent(in) :: name
type(string_container_t) :: prt_spec
prt_spec = name
end function new_prt_spec2
elemental function new_prt_spec3 (name) result (prt_spec)
type(string_array_container_t), intent(in) :: name
type(string_array_container_t) :: prt_spec
prt_spec = name
end function new_prt_spec3
end program main
! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } }
|
