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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [proc_ptr_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
! PROCEDURE POINTERS as actual/formal arguments
4
!
5
! Contributed by Janus Weil 
6
 
7
subroutine foo(j)
8
  INTEGER, INTENT(OUT) :: j
9
  j = 6
10
end subroutine
11
 
12
program proc_ptr_6
13
 
14
PROCEDURE(),POINTER :: ptr1
15
PROCEDURE(REAL),POINTER :: ptr2
16
EXTERNAL foo
17
INTEGER :: k = 0
18
 
19
ptr1 => foo
20
call s_in(ptr1,k)
21
if (k /= 6) call abort()
22
 
23
call s_out(ptr2)
24
if (ptr2(-3.0) /= 3.0) call abort()
25
 
26
contains
27
 
28
subroutine s_in(p,i)
29
  PROCEDURE(),POINTER,INTENT(IN) :: p
30
  INTEGER, INTENT(OUT) :: i
31
  call p(i)
32
end subroutine
33
 
34
subroutine s_out(p)
35
  PROCEDURE(REAL),POINTER,INTENT(OUT) :: p
36
  p => abs
37
end subroutine
38
 
39
end program

powered by: WebSVN 2.1.0

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