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

Subversion Repositories openrisc

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

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 proc_ptr_8.c }
3
!
4
! PR fortran/32580
5
! Original test case
6
!
7
! Contributed by Joost VandeVondele 
8
 
9
MODULE X
10
 
11
  USE ISO_C_BINDING
12
  INTERFACE
13
    INTEGER(KIND=C_INT) FUNCTION mytype( a ) BIND(C)
14
       USE ISO_C_BINDING
15
       INTEGER(KIND=C_INT), VALUE :: a
16
    END FUNCTION
17
    SUBROUTINE init() BIND(C,name="init")
18
    END SUBROUTINE
19
  END INTERFACE
20
 
21
  TYPE(C_FUNPTR), BIND(C,name="funpointer") :: funpointer
22
 
23
END MODULE X
24
 
25
USE X
26
PROCEDURE(mytype), POINTER :: ptype,ptype2
27
 
28
CALL init()
29
CALL C_F_PROCPOINTER(funpointer,ptype)
30
if (ptype(3) /= 9) call abort()
31
 
32
! the stuff below was added with PR 42072
33
call setpointer(ptype2)
34
if (ptype2(4) /= 12) call abort()
35
 
36
contains
37
 
38
  subroutine setpointer (p)
39
    PROCEDURE(mytype), POINTER :: p
40
    CALL C_F_PROCPOINTER(funpointer,p)
41
  end subroutine
42
 
43
END
44
 
45
! { dg-final { cleanup-modules "x" } }

powered by: WebSVN 2.1.0

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