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_f_pointer_tests.f90] - Blame information for rev 302

Details | Compare with Previous | View Log


! { dg-do run }
! { dg-additional-sources c_f_tests_driver.c }
module c_f_pointer_tests
  use, intrinsic :: iso_c_binding
 
  type myF90Derived
     integer(c_int) :: cInt
     real(c_double) :: cDouble
     real(c_float) :: cFloat
     integer(c_short) :: cShort
     type(c_funptr) :: myFunPtr
  end type myF90Derived
 
  type dummyDerived
     integer(c_int) :: myInt
  end type dummyDerived
 
  contains
 
  subroutine testDerivedPtrs(myCDerived, derivedArray, arrayLen, &
       derived2DArray, dim1, dim2) &
       bind(c, name="testDerivedPtrs")
    implicit none
    type(c_ptr), value :: myCDerived
    type(c_ptr), value :: derivedArray
    integer(c_int), value :: arrayLen
    type(c_ptr), value :: derived2DArray
    integer(c_int), value :: dim1
    integer(c_int), value :: dim2
    type(myF90Derived), pointer :: myF90Type
    type(myF90Derived), dimension(:), pointer :: myF90DerivedArray
    type(myF90Derived), dimension(:,:), pointer :: derivedArray2D
    ! one dimensional array coming in (derivedArray)
    integer(c_int), dimension(1:1) :: shapeArray
    integer(c_int), dimension(1:2) :: shapeArray2
    type(myF90Derived), dimension(1:10), target :: tmpArray
 
    call c_f_pointer(myCDerived, myF90Type)
    ! make sure numbers are ok.  initialized in c_f_tests_driver.c
    if(myF90Type%cInt .ne. 1) then
       call abort()
    endif
    if(myF90Type%cDouble .ne. 2.0d0) then
       call abort()
    endif
    if(myF90Type%cFloat .ne. 3.0) then
       call abort()
    endif
    if(myF90Type%cShort .ne. 4) then
       call abort()
    endif
 
    shapeArray(1) = arrayLen
    call c_f_pointer(derivedArray, myF90DerivedArray, shapeArray)
 
    ! upper bound of each dim is arrayLen2
    shapeArray2(1) = dim1
    shapeArray2(2) = dim2
    call c_f_pointer(derived2DArray, derivedArray2D, shapeArray2)
    ! make sure the last element is ok
    if((derivedArray2D(dim1, dim2)%cInt .ne. 4) .or. &
         (derivedArray2D(dim1, dim2)%cDouble .ne. 4.0d0) .or. &
         (derivedArray2D(dim1, dim2)%cFloat .ne. 4.0) .or. &
         (derivedArray2D(dim1, dim2)%cShort .ne. 4)) then
       call abort()
    endif
  end subroutine testDerivedPtrs
end module c_f_pointer_tests
 
! { dg-final { cleanup-modules "c_f_pointer_tests" } }

Line No.	Rev	Author	Line
1	302	jeremybenn	`! { dg-do run }`
2			`! { dg-additional-sources c_f_tests_driver.c }`
3			`module c_f_pointer_tests`
4			`use, intrinsic :: iso_c_binding`
5
6			`type myF90Derived`
7			`integer(c_int) :: cInt`
8			`real(c_double) :: cDouble`
9			`real(c_float) :: cFloat`
10			`integer(c_short) :: cShort`
11			`type(c_funptr) :: myFunPtr`
12			`end type myF90Derived`
13
14			`type dummyDerived`
15			`integer(c_int) :: myInt`
16			`end type dummyDerived`
17
18			`contains`
19
20			`subroutine testDerivedPtrs(myCDerived, derivedArray, arrayLen, &`
21			`derived2DArray, dim1, dim2) &`
22			`bind(c, name="testDerivedPtrs")`
23			`implicit none`
24			`type(c_ptr), value :: myCDerived`
25			`type(c_ptr), value :: derivedArray`
26			`integer(c_int), value :: arrayLen`
27			`type(c_ptr), value :: derived2DArray`
28			`integer(c_int), value :: dim1`
29			`integer(c_int), value :: dim2`
30			`type(myF90Derived), pointer :: myF90Type`
31			`type(myF90Derived), dimension(:), pointer :: myF90DerivedArray`
32			`type(myF90Derived), dimension(:,:), pointer :: derivedArray2D`
33			`! one dimensional array coming in (derivedArray)`
34			`integer(c_int), dimension(1:1) :: shapeArray`
35			`integer(c_int), dimension(1:2) :: shapeArray2`
36			`type(myF90Derived), dimension(1:10), target :: tmpArray`
37
38			`call c_f_pointer(myCDerived, myF90Type)`
39			`! make sure numbers are ok. initialized in c_f_tests_driver.c`
40			`if(myF90Type%cInt .ne. 1) then`
41			`call abort()`
42			`endif`
43			`if(myF90Type%cDouble .ne. 2.0d0) then`
44			`call abort()`
45			`endif`
46			`if(myF90Type%cFloat .ne. 3.0) then`
47			`call abort()`
48			`endif`
49			`if(myF90Type%cShort .ne. 4) then`
50			`call abort()`
51			`endif`
52
53			`shapeArray(1) = arrayLen`
54			`call c_f_pointer(derivedArray, myF90DerivedArray, shapeArray)`
55
56			`! upper bound of each dim is arrayLen2`
57			`shapeArray2(1) = dim1`
58			`shapeArray2(2) = dim2`
59			`call c_f_pointer(derived2DArray, derivedArray2D, shapeArray2)`
60			`! make sure the last element is ok`
61			`if((derivedArray2D(dim1, dim2)%cInt .ne. 4) .or. &`
62			`(derivedArray2D(dim1, dim2)%cDouble .ne. 4.0d0) .or. &`
63			`(derivedArray2D(dim1, dim2)%cFloat .ne. 4.0) .or. &`
64			`(derivedArray2D(dim1, dim2)%cShort .ne. 4)) then`
65			`call abort()`
66			`endif`
67			`end subroutine testDerivedPtrs`
68			`end module c_f_pointer_tests`
69
70			`! { dg-final { cleanup-modules "c_f_pointer_tests" } }`

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [c_f_pointer_tests.f90] - Blame information for rev 302