Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/internal_dummy_4.f08 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 (2020-05-25) |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { dg-do run } ! PR fortran/34133 ! PR fortran/34162 ! ! Test of using internal bind(C) procedures as ! actual argument. Bind(c) on internal procedures and ! internal procedures are actual argument are ! Fortran 2008 (draft) extension. ! module test_mod use iso_c_binding implicit none contains subroutine test_sub(a, arg, res) interface subroutine a(x) bind(C) import integer(c_int), intent(inout) :: x end subroutine a end interface integer(c_int), intent(inout) :: arg integer(c_int), intent(in) :: res call a(arg) if(arg /= res) STOP 1 end subroutine test_sub subroutine test_func(a, arg, res) interface integer(c_int) function a(x) bind(C) import integer(c_int), intent(in) :: x end function a end interface integer(c_int), intent(in) :: arg integer(c_int), intent(in) :: res if(a(arg) /= res) STOP 2 end subroutine test_func end module test_mod program main use test_mod implicit none integer :: a a = 33 call test_sub (one, a, 7*33) a = 23 call test_func(two, a, -123*23) contains subroutine one(x) bind(c) integer(c_int),intent(inout) :: x x = 7*x end subroutine one integer(c_int) function two(y) bind(c) integer(c_int),intent(in) :: y two = -123*y end function two end program main