1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4module m
5  implicit none
6  type t
7  end type t
8
9  type, extends(t) :: t2
10  end type t2
11
12  type(t) :: var_t
13  type(t2) :: var_t2
14contains
15  subroutine sub(x)
16     class(t), allocatable, intent(out) :: x(:)
17
18     if (allocated (x)) STOP 1
19     if (.not. same_type_as(x, var_t)) STOP 2
20
21     allocate (t2 :: x(5))
22  end subroutine sub
23
24  subroutine sub2(x)
25     class(t), allocatable, OPTIONAL, intent(out) :: x(:)
26
27     if (.not. present(x)) return
28     if (allocated (x)) STOP 3
29     if (.not. same_type_as(x, var_t)) STOP 4
30
31     allocate (t2 :: x(5))
32  end subroutine sub2
33end module m
34
35use m
36implicit none
37class(t), save, allocatable :: y(:)
38
39if (allocated (y)) STOP 5
40if (.not. same_type_as(y,var_t)) STOP 6
41
42call sub(y)
43if (.not.allocated(y)) STOP 7
44if (.not. same_type_as(y, var_t2)) STOP 8
45if (size (y) /= 5) STOP 9
46
47call sub(y)
48if (.not.allocated(y)) STOP 10
49if (.not. same_type_as(y, var_t2)) STOP 11
50if (size (y) /= 5) STOP 12
51
52deallocate (y)
53if (allocated (y)) STOP 13
54if (.not. same_type_as(y,var_t)) STOP 14
55
56call sub2()
57
58call sub2(y)
59if (.not.allocated(y)) STOP 15
60if (.not. same_type_as(y, var_t2)) STOP 16
61if (size (y) /= 5) STOP 17
62
63call sub2(y)
64if (.not.allocated(y)) STOP 18
65if (.not. same_type_as(y, var_t2)) STOP 19
66if (size (y) /= 5) STOP 20
67end
68
69! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
70! { dg-final { scan-tree-dump-times "finally" 0 "original" } }
71