blob: c3a30b0003c53d3ee30dc40c0fd05eb5cdc8e6a3 [file] [log] [blame]
! { dg-do compile }
! { dg-additional-options "-fcheck=bounds -fdump-tree-original" }
!
! PR fortran/104908 - incorrect out-of-bounds runtime error
program test
implicit none
type vec
integer :: x(3) = [2,4,6]
end type vec
type(vec) :: w(2)
call sub(w)
contains
subroutine sub (v)
class(vec), intent(in) :: v(:)
integer :: k, q(3)
q = [ (v(1)%x(k), k = 1, 3) ] ! <-- was failing here after r11-1235
print *, q
end
end
subroutine sub2 (zz)
implicit none
type vec
integer :: x(2,1)
end type vec
class(vec), intent(in) :: zz(:) ! used to ICE after r11-1235
integer :: k
k = zz(1)%x(2,1)
end
! { dg-final { scan-tree-dump-times " above upper bound " 4 "original" } }