1! { dg-do run }
2! { dg-options "-fbounds-check" }
3! { dg-shouldfail "foo" }
4!
5! PR 31119
6module sub_mod
7contains
8  elemental subroutine set_optional(i,idef,iopt)
9    integer, intent(out)          :: i
10    integer, intent(in)           :: idef
11    integer, intent(in), optional :: iopt
12    if (present(iopt)) then
13      i = iopt
14    else
15      i = idef
16    end if
17  end subroutine set_optional
18
19  subroutine sub(ivec)
20    integer          , intent(in), optional :: ivec(:)
21    integer                                 :: ivec_(2)
22    call set_optional(ivec_,(/1,2/))
23    if (any (ivec_ /= (/1,2/))) call abort
24    call set_optional(ivec_,(/1,2/),ivec)
25    if (present (ivec)) then
26      if (any (ivec_ /= ivec)) call abort
27    else
28      if (any (ivec_ /= (/1,2/))) call abort
29    end if
30  end subroutine sub
31end module sub_mod
32
33program main
34  use sub_mod, only: sub
35  call sub()
36  call sub((/4,5/))
37  call sub((/4/))
38end program main
39! { dg-output "Fortran runtime error: Array bound mismatch" }
40