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
|
! { dg-do run }
!
! Check that pr106576 is fixed. The temporary from the function result
! was not being finalized.
!
! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
!
module y
implicit none
type foo
integer :: n
contains
final :: cleanup
end type foo
interface assignment (=)
module procedure assign
end interface assignment (=)
character(16) :: buffer(4)
integer :: buffer_count = 1
contains
subroutine assign (rop, op)
type(foo), intent(inout) :: rop
type(foo), intent(in) :: op
rop%n = op%n + 1
write (buffer(buffer_count), '(A12,I4)') "assign", rop%n
buffer_count = buffer_count + 1
end subroutine assign
function to_foo(n) result(res)
integer, intent(in) :: n
type (foo) :: res
res%n = n
write (buffer(buffer_count), '(A12,I4)') "to_foo", res%n
buffer_count = buffer_count + 1
end function to_foo
subroutine cleanup (self)
type (foo), intent(inout) :: self
write (buffer(buffer_count), '(A12,I4)') "cleanup", self%n
buffer_count = buffer_count + 1
end subroutine cleanup
end module y
program memain
use y
implicit none
character(16) :: check(4) = [" to_foo 3", &
" assign 4", &
" cleanup 3", &
" cleanup 4"]
call chk
if (any (buffer .ne. check)) stop 1
contains
subroutine chk
type (foo) :: a
a = to_foo(3)
end subroutine chk
end program memain
|
