1! { dg-do run }
2! { dg-additional-sources bind_c_usage_24_c.c }
3!
4! PR fortran/48858
5! PR fortran/48820
6!
7! TS 29113: BIND(C) with OPTIONAL
8!
9module m
10  use iso_c_binding
11  interface
12    subroutine c_proc (is_present, var) bind(C)
13      import
14      logical(c_bool), value    :: is_present
15      integer(c_int),  optional :: var
16    end subroutine
17  end interface
18contains
19  subroutine subtest (is_present, var) bind(C)
20    logical(c_bool), intent(in),    value    :: is_present
21    integer(c_int),  intent(inout), optional :: var
22    if (is_present) then
23      if (.not. present (var)) call abort ()
24      if (var /= 43) call abort ()
25      var = -45
26    else
27      if (present (var)) call abort ()
28    end if
29  end subroutine subtest
30end module m
31
32program test
33  use m
34  implicit none
35  integer :: val
36
37  val = 4
38  call c_proc (.false._c_bool)
39  call c_proc (.true._c_bool, val)
40  if (val /= 7) call abort ()
41end program test
42