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

Subversion Repositories openrisc

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

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


! { dg-do run }
!
! NULL() initialization for PROCEDURE POINTERS
!
! Contributed by Tobias Burnus 
 
program main
implicit none
call test(.true.)
call test(.false.)
 
contains
 
integer function hello()
 hello = 42
end function hello
 
subroutine test(first)
 logical :: first
 integer :: i
 procedure(integer), pointer :: x => null()
 
 if(first) then
  if(associated(x)) call abort()
  x => hello
 else
  if(.not. associated(x)) call abort()
  i = x()
  if(i /= 42) call abort()
 end if
 end subroutine test
 
end program main

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! NULL() initialization for PROCEDURE POINTERS`
4			`!`
5			`! Contributed by Tobias Burnus`
6
7			`program main`
8			`implicit none`
9			`call test(.true.)`
10			`call test(.false.)`
11
12			`contains`
13
14			`integer function hello()`
15			`hello = 42`
16			`end function hello`
17
18			`subroutine test(first)`
19			`logical :: first`
20			`integer :: i`
21			`procedure(integer), pointer :: x => null()`
22
23			`if(first) then`
24			`if(associated(x)) call abort()`
25			`x => hello`
26			`else`
27			`if(.not. associated(x)) call abort()`
28			`i = x()`
29			`if(i /= 42) call abort()`
30			`end if`
31			`end subroutine test`
32
33			`end program main`

Browse

Tools

Subversion Repositories openrisc

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