OpenCores
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 694

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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