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

Details | Compare with Previous | View Log

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" } }

powered by: WebSVN 2.1.0

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