gcc-4_9/gcc/testsuite/gfortran.dg/internal_dummy_4.f08

   1 ! { dg-do run }
   2 ! PR fortran/34133
   3 ! PR fortran/34162
   4 !
   5 ! Test of using internal bind(C) procedures as
   6 ! actual argument. Bind(c) on internal procedures and
   7 ! internal procedures are actual argument are
   8 ! Fortran 2008 (draft) extension.
   9 !
  10 module test_mod
  11   use iso_c_binding
  12   implicit none
  13 contains
  14   subroutine test_sub(a, arg, res)
  15     interface
  16       subroutine a(x) bind(C)
  17         import
  18         integer(c_int), intent(inout) :: x
  19       end subroutine a
  20     end interface
  21     integer(c_int), intent(inout) :: arg
  22     integer(c_int), intent(in) :: res
  23     call a(arg)
  24     if(arg /= res) call abort()
  25   end subroutine test_sub
  26   subroutine test_func(a, arg, res)
  27     interface
  28       integer(c_int) function a(x) bind(C)
  29         import
  30         integer(c_int), intent(in) :: x
  31       end function a
  32     end interface
  33     integer(c_int), intent(in) :: arg
  34     integer(c_int), intent(in) :: res
  35     if(a(arg) /= res) call abort()
  36   end subroutine test_func
  37 end module test_mod
  38
  39 program main
  40   use test_mod
  41   implicit none
  42   integer :: a
  43   a = 33
  44   call test_sub (one, a, 7*33)
  45   a = 23
  46   call test_func(two, a, -123*23)
  47 contains
  48   subroutine one(x) bind(c)
  49      integer(c_int),intent(inout) :: x
  50      x = 7*x
  51   end subroutine one
  52   integer(c_int) function two(y) bind(c)
  53      integer(c_int),intent(in) :: y
  54      two = -123*y
  55   end function two
  56 end program main