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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [c_assoc.f90] - Blame information for rev 801

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

Line No. Rev Author Line
1 694 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.