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_assoc.f90] - Blame information for rev 414

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 test_c_assoc.c }
3
module c_assoc
4
  use, intrinsic :: iso_c_binding
5
  implicit none
6
 
7
contains
8
 
9
  function test_c_assoc_0(my_c_ptr) bind(c)
10
    use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_associated
11
    integer(c_int) :: test_c_assoc_0
12
    type(c_ptr), value :: my_c_ptr
13
 
14
    if(c_associated(my_c_ptr)) then
15
       test_c_assoc_0 = 1
16
    else
17
       test_c_assoc_0 = 0
18
    endif
19
  end function test_c_assoc_0
20
 
21
  function test_c_assoc_1(my_c_ptr_1, my_c_ptr_2) bind(c)
22
    use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_associated
23
    integer(c_int) :: test_c_assoc_1
24
    type(c_ptr), value :: my_c_ptr_1
25
    type(c_ptr), value :: my_c_ptr_2
26
 
27
    if(c_associated(my_c_ptr_1, my_c_ptr_2)) then
28
       test_c_assoc_1 = 1
29
    else
30
       test_c_assoc_1 = 0
31
    endif
32
  end function test_c_assoc_1
33
 
34
  function test_c_assoc_2(my_c_ptr_1, my_c_ptr_2, num_ptrs) bind(c)
35
    integer(c_int) :: test_c_assoc_2
36
    type(c_ptr), value :: my_c_ptr_1
37
    type(c_ptr), value :: my_c_ptr_2
38
    integer(c_int), value :: num_ptrs
39
 
40
    if(num_ptrs .eq. 1) then
41
       if(c_associated(my_c_ptr_1)) then
42
          test_c_assoc_2 = 1
43
       else
44
          test_c_assoc_2 = 0
45
       endif
46
    else
47
       if(c_associated(my_c_ptr_1, my_c_ptr_2)) then
48
          test_c_assoc_2 = 1
49
       else
50
          test_c_assoc_2 = 0
51
       endif
52
    endif
53
  end function test_c_assoc_2
54
 
55
  subroutine verify_assoc(my_c_ptr_1, my_c_ptr_2) bind(c)
56
    type(c_ptr), value :: my_c_ptr_1
57
    type(c_ptr), value :: my_c_ptr_2
58
 
59
    if(.not. c_associated(my_c_ptr_1)) then
60
       call abort()
61
    else if(.not. c_associated(my_c_ptr_2)) then
62
       call abort()
63
    else if(.not. c_associated(my_c_ptr_1, my_c_ptr_2)) then
64
       call abort()
65
    endif
66
  end subroutine verify_assoc
67
 
68
end module c_assoc
69
 
70
! { dg-final { cleanup-modules "c_assoc" } }

powered by: WebSVN 2.1.0

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