gcc/testsuite/gfortran.dg/binding_label_tests_25.f90

   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
  10 module 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
  35 end module
  36
  37 module 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
  53 end module graph_partitions
  54
  55 program test
  56   use graph_partitions
  57   integer(c_int) :: a(100)
  58
  59   call Cfun (1, a)
  60   call Cfun (2, C_NULL_PTR)
  61 end program test