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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-additional-sources c_ptr_tests_driver.c }
3
module c_ptr_tests
4
  use, intrinsic :: iso_c_binding
5
 
6
  ! TODO::
7
  ! in order to be associated with a C address,
8
  ! the derived type needs to be C interoperable,
9
  ! which requires bind(c) and all fields interoperable.
10
  type, bind(c) :: myType
11
     type(c_ptr) :: myServices
12
     type(c_funptr) :: mySetServices
13
     type(c_ptr) :: myPort
14
  end type myType
15
 
16
  type, bind(c) :: f90Services
17
     integer(c_int) :: compId
18
     type(c_ptr) :: globalServices = c_null_ptr
19
  end type f90Services
20
 
21
  contains
22
 
23
    subroutine sub0(c_self, services) bind(c)
24
      use, intrinsic :: iso_c_binding
25
      implicit none
26
      type(c_ptr), value :: c_self, services
27
      type(myType), pointer :: self
28
      type(f90Services), pointer :: localServices
29
!      type(c_ptr) :: my_cptr
30
      type(c_ptr), save :: my_cptr = c_null_ptr
31
 
32
      call c_f_pointer(c_self, self)
33
      if(.not. associated(self)) then
34
         print *, 'self is not associated'
35
      end if
36
      self%myServices = services
37
 
38
      ! c_null_ptr is defined in iso_c_binding
39
      my_cptr = c_null_ptr
40
 
41
      ! get access to the local services obj from C
42
      call c_f_pointer(self%myServices, localServices)
43
    end subroutine sub0
44
end module c_ptr_tests
45
 
46
! { dg-final { cleanup-modules "c_ptr_tests" } }

powered by: WebSVN 2.1.0

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