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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


! { dg-do run }
! { dg-additional-sources iso_c_binding_rename_1_driver.c }
module iso_c_binding_rename_0
  use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr, &
       c_associated
end module iso_c_binding_rename_0
 
 
module iso_c_binding_rename_1
  ! rename a couple of the symbols from iso_c_binding.  the compiler
  ! needs to be able to recognize the derived types with names different
  ! from the one in iso_c_binding because it will look up the derived types
  ! to define the args and return values of some of the procedures in
  ! iso_c_binding.  this should verify that this functionality works.
  use, intrinsic :: iso_c_binding, my_c_int => c_int, my_c_ptr => c_ptr, &
       my_c_associated => c_associated, my_c_f_pointer => c_f_pointer
 
contains
  subroutine sub0(my_int) bind(c)
    integer(my_c_int), value :: my_int
    if(my_int .ne. 1) then
       call abort()
    end if
  end subroutine sub0
 
  subroutine sub1(my_ptr) bind(c)
    type(my_c_ptr), value :: my_ptr
 
    if(.not. my_c_associated(my_ptr)) then
       call abort()
    end if
  end subroutine sub1
 
  subroutine sub2(my_int, my_long) bind(c)
    use, intrinsic :: iso_c_binding, my_c_int_2 => c_int, &
         my_c_long_2 => c_long
    integer(my_c_int_2), value :: my_int
    integer(my_c_long_2), value :: my_long
 
    if(my_int .ne. 1) then
       call abort()
    end if
    if(my_long .ne. 1) then
       call abort()
    end if
  end subroutine sub2
 
  subroutine sub3(cptr1, cptr2) bind(c)
    type(my_c_ptr), value :: cptr1
    type(my_c_ptr), value :: cptr2
    integer(my_c_int), pointer :: my_f90_c_ptr
 
    if(.not. my_c_associated(cptr1)) then
       call abort()
    end if
 
    if(.not. my_c_associated(cptr1, cptr2)) then
       call abort()
    end if
 
    call my_c_f_pointer(cptr1, my_f90_c_ptr)
  end subroutine sub3
 
  subroutine sub4(cptr1, cptr2) bind(c)
    ! rename the my_c_ptr_0 from iso_c_binding_rename_0 just to further test
    ! both are actually aliases to c_ptr
    use iso_c_binding_rename_0, my_c_ptr_local => my_c_ptr_0, &
         my_c_associated_2 => c_associated
 
    implicit none
    type(my_c_ptr_local), value :: cptr1
    type(my_c_ptr_local), value :: cptr2
 
    if(.not. my_c_associated_2(cptr1)) then
       call abort()
    end if
 
    if(.not. my_c_associated_2(cptr2)) then
       call abort()
    end if
  end subroutine sub4
end module iso_c_binding_rename_1
 
! { dg-final { cleanup-modules "iso_c_binding_rename_0 iso_c_binding_rename_1" } }

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`! { dg-additional-sources iso_c_binding_rename_1_driver.c }`
3			`module iso_c_binding_rename_0`
4			`use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr, &`
5			`c_associated`
6			`end module iso_c_binding_rename_0`
7
8
9			`module iso_c_binding_rename_1`
10			`! rename a couple of the symbols from iso_c_binding. the compiler`
11			`! needs to be able to recognize the derived types with names different`
12			`! from the one in iso_c_binding because it will look up the derived types`
13			`! to define the args and return values of some of the procedures in`
14			`! iso_c_binding. this should verify that this functionality works.`
15			`use, intrinsic :: iso_c_binding, my_c_int => c_int, my_c_ptr => c_ptr, &`
16			`my_c_associated => c_associated, my_c_f_pointer => c_f_pointer`
17
18			`contains`
19			`subroutine sub0(my_int) bind(c)`
20			`integer(my_c_int), value :: my_int`
21			`if(my_int .ne. 1) then`
22			`call abort()`
23			`end if`
24			`end subroutine sub0`
25
26			`subroutine sub1(my_ptr) bind(c)`
27			`type(my_c_ptr), value :: my_ptr`
28
29			`if(.not. my_c_associated(my_ptr)) then`
30			`call abort()`
31			`end if`
32			`end subroutine sub1`
33
34			`subroutine sub2(my_int, my_long) bind(c)`
35			`use, intrinsic :: iso_c_binding, my_c_int_2 => c_int, &`
36			`my_c_long_2 => c_long`
37			`integer(my_c_int_2), value :: my_int`
38			`integer(my_c_long_2), value :: my_long`
39
40			`if(my_int .ne. 1) then`
41			`call abort()`
42			`end if`
43			`if(my_long .ne. 1) then`
44			`call abort()`
45			`end if`
46			`end subroutine sub2`
47
48			`subroutine sub3(cptr1, cptr2) bind(c)`
49			`type(my_c_ptr), value :: cptr1`
50			`type(my_c_ptr), value :: cptr2`
51			`integer(my_c_int), pointer :: my_f90_c_ptr`
52
53			`if(.not. my_c_associated(cptr1)) then`
54			`call abort()`
55			`end if`
56
57			`if(.not. my_c_associated(cptr1, cptr2)) then`
58			`call abort()`
59			`end if`
60
61			`call my_c_f_pointer(cptr1, my_f90_c_ptr)`
62			`end subroutine sub3`
63
64			`subroutine sub4(cptr1, cptr2) bind(c)`
65			`! rename the my_c_ptr_0 from iso_c_binding_rename_0 just to further test`
66			`! both are actually aliases to c_ptr`
67			`use iso_c_binding_rename_0, my_c_ptr_local => my_c_ptr_0, &`
68			`my_c_associated_2 => c_associated`
69
70			`implicit none`
71			`type(my_c_ptr_local), value :: cptr1`
72			`type(my_c_ptr_local), value :: cptr2`
73
74			`if(.not. my_c_associated_2(cptr1)) then`
75			`call abort()`
76			`end if`
77
78			`if(.not. my_c_associated_2(cptr2)) then`
79			`call abort()`
80			`end if`
81			`end subroutine sub4`
82			`end module iso_c_binding_rename_1`
83
84			`! { dg-final { cleanup-modules "iso_c_binding_rename_0 iso_c_binding_rename_1" } }`

Browse

Tools

Subversion Repositories openrisc

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