1! { dg-do compile }
2!
3! PR fortran/48858
4! PR fortran/55465
5!
6! Seems to be regarded as valid, even if it is doubtful
7!
8
9
10module m_odbc_if
11  implicit none
12
13  interface sql_set_env_attr
14    function sql_set_env_attr_int( input_handle,attribute,value,length ) &
15                                   result(res) bind(C,name="SQLSetEnvAttr")
16      use, intrinsic :: iso_c_binding
17      implicit none
18      type(c_ptr), value :: input_handle
19      integer(c_int), value :: attribute
20      integer(c_int), value :: value  ! <<<< HERE: int passed by value (int with ptr address)
21      integer(c_int), value :: length
22      integer(c_short) :: res
23    end function
24    function sql_set_env_attr_ptr( input_handle,attribute,value,length ) &
25                                   result(res) bind(C,name="SQLSetEnvAttr")
26      use, intrinsic :: iso_c_binding
27      implicit none
28      type(c_ptr), value :: input_handle
29      integer(c_int), value :: attribute
30      type(c_ptr), value :: value ! <<< HERE: "void *" (pointer address)
31      integer(c_int), value :: length
32      integer(c_short) :: res
33    end function
34  end interface
35end module
36
37module graph_partitions
38  use,intrinsic :: iso_c_binding
39
40  interface Cfun
41     subroutine cfunc1 (num, array) bind(c, name="Cfun")
42       import :: c_int
43       integer(c_int),value :: num
44       integer(c_int)       :: array(*) ! <<< HERE: int[]
45     end subroutine cfunc1
46
47     subroutine cfunf2 (num, array) bind(c, name="Cfun")
48       import :: c_int, c_ptr
49       integer(c_int),value :: num
50       type(c_ptr),value    :: array ! <<< HERE: void*
51     end subroutine cfunf2
52  end interface
53end module graph_partitions
54
55program test
56  use graph_partitions
57  integer(c_int) :: a(100)
58
59  call Cfun (1, a)
60  call Cfun (2, C_NULL_PTR)
61end program test
62