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)) call abort() 19 if (.not. same_type_as(x, var_t)) call abort() 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)) call abort() 29 if (.not. same_type_as(x, var_t)) call abort() 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)) call abort() 40if (.not. same_type_as(y,var_t)) call abort() 41 42call sub(y) 43if (.not.allocated(y)) call abort() 44if (.not. same_type_as(y, var_t2)) call abort() 45if (size (y) /= 5) call abort() 46 47call sub(y) 48if (.not.allocated(y)) call abort() 49if (.not. same_type_as(y, var_t2)) call abort() 50if (size (y) /= 5) call abort() 51 52deallocate (y) 53if (allocated (y)) call abort() 54if (.not. same_type_as(y,var_t)) call abort() 55 56call sub2() 57 58call sub2(y) 59if (.not.allocated(y)) call abort() 60if (.not. same_type_as(y, var_t2)) call abort() 61if (size (y) /= 5) call abort() 62 63call sub2(y) 64if (.not.allocated(y)) call abort() 65if (.not. same_type_as(y, var_t2)) call abort() 66if (size (y) /= 5) call abort() 67end 68 69! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } } 70! { dg-final { scan-tree-dump-times "finally" 0 "original" } } 71! { dg-final { cleanup-tree-dump "original" } } 72