OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [proc_ptr_8.f90] - Rev 437

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

! { dg-do run }
! { dg-additional-sources proc_ptr_8.c }
!
! PR fortran/32580
! Original test case
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>

MODULE X

  USE ISO_C_BINDING
  INTERFACE
    INTEGER(KIND=C_INT) FUNCTION mytype( a ) BIND(C)
       USE ISO_C_BINDING
       INTEGER(KIND=C_INT), VALUE :: a
    END FUNCTION
    SUBROUTINE init() BIND(C,name="init")
    END SUBROUTINE
  END INTERFACE

  TYPE(C_FUNPTR), BIND(C,name="funpointer") :: funpointer

END MODULE X

USE X
PROCEDURE(mytype), POINTER :: ptype,ptype2

CALL init()
CALL C_F_PROCPOINTER(funpointer,ptype)
if (ptype(3) /= 9) call abort()

! the stuff below was added with PR 42072
call setpointer(ptype2)
if (ptype2(4) /= 12) call abort()

contains

  subroutine setpointer (p)
    PROCEDURE(mytype), POINTER :: p
    CALL C_F_PROCPOINTER(funpointer,p)
  end subroutine

END

! { dg-final { cleanup-modules "X" } }

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

powered by: WebSVN 2.1.0

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