Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/class_array_16.f90 @ 144:8f4e72ab4e11
fix segmentation fault caused by nothing next cur_op to end
author | Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 23 Dec 2018 21:23:56 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { 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" } }