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

Subversion Repositories openrisc

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

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


! { dg-do run }
!
! PR39630: Fortran 2003: Procedure pointer components.
!
! Nested types / double component references.
!
! Contributed by Janus Weil 
 
abstract interface
  subroutine as
  end subroutine
  integer function af()
  end function
end interface
 
type :: t1
  procedure(as), pointer, nopass :: s
  procedure(af), pointer, nopass :: f
end type
 
type :: t2
  type(t1) :: c
end type
 
type(t2) :: x
integer :: j = 0
 
x%c%s => is
call x%c%s
if (j/=5) call abort
 
x%c%f => if
j=x%c%f()
if (j/=42) call abort
 
contains
 
subroutine is
  j = 5
end subroutine
 
integer function if()
  if = 42
end function
 
end
 

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! PR39630: Fortran 2003: Procedure pointer components.`
4			`!`
5			`! Nested types / double component references.`
6			`!`
7			`! Contributed by Janus Weil`
8
9			`abstract interface`
10			`subroutine as`
11			`end subroutine`
12			`integer function af()`
13			`end function`
14			`end interface`
15
16			`type :: t1`
17			`procedure(as), pointer, nopass :: s`
18			`procedure(af), pointer, nopass :: f`
19			`end type`
20
21			`type :: t2`
22			`type(t1) :: c`
23			`end type`
24
25			`type(t2) :: x`
26			`integer :: j = 0`
27
28			`x%c%s => is`
29			`call x%c%s`
30			`if (j/=5) call abort`
31
32			`x%c%f => if`
33			`j=x%c%f()`
34			`if (j/=42) call abort`
35
36			`contains`
37
38			`subroutine is`
39			`j = 5`
40			`end subroutine`
41
42			`integer function if()`
43			`if = 42`
44			`end function`
45
46			`end`
47

Browse

Tools

Subversion Repositories openrisc

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