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
|
! { dg-do run }
!
! Test the fix for all three variants of PR82996, which used to
! segfault in the original testcase and ICE in the testcases of
! comments 1 and 2.
!
! Contributed by Neil Carlson <neil.n.carlson@gmail.com>
!
module mod0
integer :: final_count_foo = 0
integer :: final_count_bar = 0
end module mod0
!
! This is the original testcase, with a final routine 'foo' but
! but not in the container type 'bar1'.
!
module mod1
use mod0
private foo, foo_destroy
type foo
integer, pointer :: f(:) => null()
contains
final :: foo_destroy
end type
type bar1
type(foo) :: b(2)
end type
contains
impure elemental subroutine foo_destroy(this)
type(foo), intent(inout) :: this
final_count_foo = final_count_foo + 1
if (associated(this%f)) deallocate(this%f)
end subroutine
end module mod1
!
! Comment 1 was the same as original, except that the
! 'foo' finalizer is elemental and a 'bar' finalizer is added..
!
module mod2
use mod0
private foo, foo_destroy, bar_destroy
type foo
integer, pointer :: f(:) => null()
contains
final :: foo_destroy
end type
type bar2
type(foo) :: b(2)
contains
final :: bar_destroy
end type
contains
impure elemental subroutine foo_destroy(this)
type(foo), intent(inout) :: this
final_count_foo = final_count_foo + 1
if (associated(this%f)) deallocate(this%f)
end subroutine
subroutine bar_destroy(this)
type(bar2), intent(inout) :: this
final_count_bar = final_count_bar + 1
call foo_destroy(this%b)
end subroutine
end module mod2
!
! Comment 2 was the same as comment 1, except that the 'foo'
! finalizer is no longer elemental.
!
module mod3
use mod0
private foo, foo_destroy, bar_destroy
type foo
integer, pointer :: f(:) => null()
contains
final :: foo_destroy
end type
type bar3
type(foo) :: b(2)
contains
final :: bar_destroy
end type
contains
subroutine foo_destroy(this)
type(foo), intent(inout) :: this
final_count_foo = final_count_foo + 1
if (associated(this%f)) deallocate(this%f)
end subroutine
subroutine bar_destroy(this)
type(bar3), intent(inout) :: this
final_count_bar = final_count_bar + 1
do j = 1, size(this%b)
call foo_destroy(this%b(j))
end do
end subroutine
end module mod3
program main
use mod0
use mod1
use mod2
use mod3
type(bar1) :: x
type(bar2) :: y
type(bar3) :: z
call sub1(x)
if (final_count_foo /= 2) stop 1
if (final_count_bar /= 0) stop 2
call sub2(y)
if (final_count_foo /= 6) stop 3
if (final_count_bar /= 1) stop 4
call sub3(z)
if (final_count_foo /= 8) stop 5
if (final_count_bar /= 2) stop 6
contains
subroutine sub1(x)
type(bar1), intent(out) :: x
end subroutine
subroutine sub2(x)
type(bar2), intent(out) :: x
end subroutine
subroutine sub3(x)
type(bar3), intent(out) :: x
end subroutine
end program
|
