1! { dg-do run }
2! { dg-options "-fdump-tree-original -fdump-tree-original -fmax-stack-var-size=1" }
3!
4! PR fortran/56845
5!
6type t
7end type t
8type, extends(t) :: t2
9end type t2
10type(t) :: y
11call foo()
12call bar()
13contains
14  subroutine foo()
15    class(t), allocatable :: x
16    if(allocated(x)) STOP 1
17    if(.not.same_type_as(x,y)) STOP 2
18    allocate (t2 :: x)
19  end
20  subroutine bar()
21    class(t), allocatable :: x(:)
22    if(allocated(x)) STOP 3
23    if(.not.same_type_as(x,y)) STOP 4
24    allocate (t2 :: x(4))
25  end
26end
27! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
28