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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [proc_ptr_comp_pass_2.f90] - Rev 694

Compare with Previous | Blame | View Log

! { dg-do run }
!
! PR 39630: [F03] Procedure Pointer Components with PASS
!
! taken from "The Fortran 2003 Handbook" (Adams et al., 2009)

module passed_object_example

  type t
    real :: a
    procedure(print_me), pointer, pass(arg) :: proc
  end type t

contains

  subroutine print_me (arg, lun)
    class(t), intent(in) :: arg
    integer, intent(in) :: lun
    if (abs(arg%a-2.718)>1E-6) call abort()
    write (lun,*) arg%a
  end subroutine print_me

  subroutine print_my_square (arg, lun)
    class(t), intent(in) :: arg
    integer, intent(in) :: lun
    if (abs(arg%a-2.718)>1E-6) call abort()
    write (lun,*) arg%a**2
  end subroutine print_my_square

end module passed_object_example


program main
  use passed_object_example
  use iso_fortran_env, only: output_unit

  type(t) :: x

  x%a = 2.718
  x%proc => print_me
  call x%proc (output_unit)
  x%proc => print_my_square
  call x%proc (output_unit)

end program main

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

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.