1! { dg-do compile }
2! { dg-options "-Wno-c-binding-type" }
3!
4! That's a copy of "bind_c_usage_8.f03", "bind_c_dts_4.f03",
5! "bind_c_implicit_vars.f03" and "c_kind_tests_2.f03"
6! to check that with -Wno-c-binding-type no warning is printed.
7!
8
9MODULE ISO_C_UTILITIES
10   USE ISO_C_BINDING
11   implicit none
12   CHARACTER(C_CHAR), DIMENSION(1), SAVE, TARGET, PRIVATE :: dummy_string="?"
13CONTAINS
14   FUNCTION C_F_STRING(CPTR) RESULT(FPTR)
15     use, intrinsic :: iso_c_binding
16      TYPE(C_PTR), INTENT(IN) :: CPTR ! The C address
17      CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: FPTR
18      INTERFACE
19         FUNCTION strlen(string) RESULT(len) BIND(C,NAME="strlen")
20            USE ISO_C_BINDING
21            TYPE(C_PTR), VALUE :: string ! A C pointer
22         END FUNCTION
23      END INTERFACE
24      CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR, SHAPE=[strlen(CPTR)])
25   END FUNCTION
26END MODULE ISO_C_UTILITIES
27
28module test
29use iso_c_binding, only: c_int
30    type, bind(c) ::  foo
31      integer :: p
32    end type
33    type(foo), bind(c) :: cp
34end module test
35
36module bind_c_implicit_vars
37
38bind(c) :: j
39
40contains
41  subroutine sub0(i) bind(c)
42    i = 0
43  end subroutine sub0
44end module bind_c_implicit_vars
45
46module c_kind_tests_2
47  use, intrinsic :: iso_c_binding
48
49  integer, parameter :: myF = c_float
50  real(myF), bind(c) :: myCFloat
51  integer(myF), bind(c) :: myCInt       ! { dg-warning "is for type REAL" }
52  integer(c_double), bind(c) :: myCInt2 ! { dg-warning "is for type REAL" }
53
54  integer, parameter :: myI = c_int
55  real(myI) :: myReal             ! { dg-warning "is for type INTEGER" }
56  real(myI), bind(c) :: myCFloat2 ! { dg-warning "is for type INTEGER" }
57  real(4), bind(c) :: myFloat
58end module c_kind_tests_2
59