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

Subversion Repositories openrisc_2011-10-31

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
!
3
! PR39630: Fortran 2003: Procedure pointer components.
4
!
5
! test case taken from:
6
! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742?#884b9eca6d7e6742
7
! http://fortranwiki.org/fortran/show/proc_component_example
8
 
9
module proc_component_example
10
 
11
  type t
12
    real :: a
13
    procedure(print_int), pointer, &
14
                          nopass :: proc
15
  end type t
16
 
17
  abstract interface
18
    subroutine print_int (arg, lun)
19
      import
20
      type(t), intent(in) :: arg
21
      integer, intent(in) :: lun
22
    end subroutine print_int
23
  end interface
24
 
25
  integer :: calls = 0
26
 
27
contains
28
 
29
  subroutine print_me (arg, lun)
30
    type(t), intent(in) :: arg
31
    integer, intent(in) :: lun
32
    write (lun,*) arg%a
33
    calls = calls + 1
34
  end subroutine print_me
35
 
36
  subroutine print_my_square (arg, lun)
37
    type(t), intent(in) :: arg
38
    integer, intent(in) :: lun
39
    write (lun,*) arg%a**2
40
    calls = calls + 1
41
  end subroutine print_my_square
42
 
43
end module proc_component_example
44
 
45
program main
46
 
47
    use proc_component_example
48
    use iso_fortran_env, only : output_unit
49
 
50
    type(t) :: x
51
 
52
    x%a = 2.71828
53
 
54
    x%proc => print_me
55
    call x%proc(x, output_unit)
56
    x%proc => print_my_square
57
    call x%proc(x, output_unit)
58
 
59
    if (calls/=2) call abort
60
 
61
end program main
62
 
63
! { dg-final { cleanup-modules "proc_component_example" } }
64
 

powered by: WebSVN 2.1.0

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