OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [c_funloc_tests_3.f03] - Blame information for rev 399

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! { dg-additional-sources c_funloc_tests_3_funcs.c }
3
! This testcase tests c_funloc and c_funptr from iso_c_binding.  It uses
4
! functions defined in c_funloc_tests_3_funcs.c.
5
module c_funloc_tests_3
6
 implicit none
7
contains
8
  function ffunc(j) bind(c)
9
    use iso_c_binding, only: c_funptr, c_int
10
    integer(c_int)        :: ffunc
11
    integer(c_int), value :: j
12
    ffunc = -17*j
13
  end function ffunc
14
end module c_funloc_tests_3
15
program main
16
  use iso_c_binding, only: c_funptr, c_funloc
17
  use c_funloc_tests_3, only: ffunc
18
  implicit none
19
  interface
20
    function returnFunc() bind(c,name="returnFunc")
21
       use iso_c_binding, only: c_funptr
22
       type(c_funptr) :: returnFunc
23
    end function returnFunc
24
    subroutine callFunc(func,pass,compare) bind(c,name="callFunc")
25
       use iso_c_binding, only: c_funptr, c_int
26
       type(c_funptr), value :: func
27
       integer(c_int), value :: pass,compare
28
    end subroutine callFunc
29
  end interface
30
  type(c_funptr) :: p
31
  p = returnFunc()
32
  call callFunc(p, 13,3*13)
33
  p = c_funloc(ffunc)
34
  call callFunc(p, 21,-17*21)
35
end program main
36
! { dg-final { cleanup-modules "c_funloc_tests_3" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.