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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [proc_ptr_comp_1.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
! PR39630: Fortran 2003: Procedure pointer components.
4
!
5
! Basic test for PPCs with SUBROUTINE interface and NOPASS.
6
!
7
! Contributed by Janus Weil 
8
 
9
  type t
10
    integer :: i
11
    procedure(sub), pointer, nopass :: ppc
12
    procedure(), pointer, nopass :: proc
13
  end type
14
 
15
  type, extends(t) :: t2
16
    procedure(), pointer, nopass :: proc2
17
  end type t2
18
 
19
  type(t) :: x
20
  type(t2) :: x2
21
 
22
  procedure(sub),pointer :: pp
23
  integer :: sum = 0
24
 
25
  x%i = 1
26
  x%ppc => sub
27
  pp => x%ppc
28
 
29
  call sub(1)
30
  if (sum/=1) call abort
31
  call pp(2)
32
  if (sum/=3) call abort
33
  call x%ppc(3)
34
  if (sum/=6) call abort
35
 
36
  ! calling object as argument
37
  x%proc => sub2
38
  call x%proc(x)
39
  if (x%i/=7) call abort
40
 
41
  ! type extension
42
  x%proc => sub
43
  call x%proc(4)
44
  if (sum/=10) call abort
45
  x2%proc => sub
46
  call x2%proc(5)
47
  if (sum/=15) call abort
48
  x2%proc2 => sub
49
  call x2%proc2(6)
50
  if (sum/=21) call abort
51
 
52
contains
53
 
54
  subroutine sub(y)
55
    integer, intent(in) :: y
56
    sum = sum + y
57
  end subroutine
58
 
59
  subroutine sub2(arg)
60
    type(t),intent(inout) :: arg
61
    arg%i = arg%i + sum
62
  end subroutine
63
 
64
end
65
 

powered by: WebSVN 2.1.0

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