gcc/testsuite/gfortran.dg/binding_label_tests_3.f03

   1 ! { dg-do compile }
   2 program main
   3 use iso_c_binding
   4   interface
   5      subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! Doubtful use ...
   6        import :: c_ptr, c_int, c_double
   7        type(c_ptr), value :: f
   8        integer(c_int), value :: a1, a3
   9        real(c_double), value :: a2, a4
  10      end subroutine p1
  11
  12      subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! ... with incompatible interfaces
  13        import :: c_ptr, c_int, c_double
  14        type(c_ptr), value :: f
  15        real(c_double), value :: a1, a3
  16        integer(c_int), value :: a2, a4
  17      end subroutine p2
  18   end interface
  19
  20   type(c_ptr) :: f_ptr
  21   character(len=20), target :: format
  22
  23   f_ptr = c_loc(format(1:1))
  24
  25   format = 'Hello %d %f %d %f\n' // char(0)
  26   call p1(f_ptr, 10, 1.23d0, 20, 2.46d0)
  27
  28   format = 'World %f %d %f %d\n' // char(0)
  29   call p2(f_ptr, 1.23d0, 10, 2.46d0, 20)
  30 end program main