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
|
! { dg-do run }
! { dg-options "-fdump-tree-original" }
!
module m
implicit none
type t
end type t
type, extends(t) :: t2
end type t2
type(t) :: var_t
type(t2) :: var_t2
contains
subroutine sub(x)
class(t), allocatable, intent(out) :: x(:)
if (allocated (x)) STOP 1
if (.not. same_type_as(x, var_t)) STOP 2
allocate (t2 :: x(5))
end subroutine sub
subroutine sub2(x)
class(t), allocatable, OPTIONAL, intent(out) :: x(:)
if (.not. present(x)) return
if (allocated (x)) STOP 3
if (.not. same_type_as(x, var_t)) STOP 4
allocate (t2 :: x(5))
end subroutine sub2
end module m
use m
implicit none
class(t), save, allocatable :: y(:)
if (allocated (y)) STOP 5
if (.not. same_type_as(y,var_t)) STOP 6
call sub(y)
if (.not.allocated(y)) STOP 7
if (.not. same_type_as(y, var_t2)) STOP 8
if (size (y) /= 5) STOP 9
call sub(y)
if (.not.allocated(y)) STOP 10
if (.not. same_type_as(y, var_t2)) STOP 11
if (size (y) /= 5) STOP 12
deallocate (y)
if (allocated (y)) STOP 13
if (.not. same_type_as(y,var_t)) STOP 14
call sub2()
call sub2(y)
if (.not.allocated(y)) STOP 15
if (.not. same_type_as(y, var_t2)) STOP 16
if (size (y) /= 5) STOP 17
call sub2(y)
if (.not.allocated(y)) STOP 18
if (.not. same_type_as(y, var_t2)) STOP 19
if (size (y) /= 5) STOP 20
end
! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
! { dg-final { scan-tree-dump-times "finally" 0 "original" } }
|
