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