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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [lto/] [20100222-1_0.f03] - Blame information for rev 694

Details | Compare with Previous | View Log

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