1! { dg-do compile }
2! { dg-options "-Wc-binding-type" }
3!
4! PR fortran/38160
5!
6
7subroutine foo(x,y,z,a) bind(c) ! { dg-warning "but may not be C interoperable" }
8  use iso_c_binding
9  implicit none
10  integer(4) :: x
11  integer(c_float) :: y ! { dg-warning "C kind type parameter is for type REAL" }
12  complex(c_float) :: z ! OK, c_float == c_float_complex
13  real(c_float_complex) :: a ! OK, c_float == c_float_complex
14end subroutine foo
15
16use iso_c_binding
17implicit none
18integer, parameter :: it = c_int
19integer, parameter :: dt = c_double
20complex(c_int), target    :: z1  ! { dg-warning "C kind type parameter is for type INTEGER" }
21complex(it), target       :: z2  ! { dg-warning "C kind type parameter is for type INTEGER" }
22complex(c_double), target :: z3  ! OK
23complex(dt), target       :: z4  ! OK
24type(c_ptr) :: ptr
25
26ptr = c_loc(z1)
27ptr = c_loc(z2)
28ptr = c_loc(z3)
29ptr = c_loc(z4)
30end
31