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/] [protected_1.f90] - Blame information for rev 414

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

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! { dg-options "-std=f2003 -fall-intrinsics" }
3
! PR fortran/23994
4
!
5
! Test PROTECTED attribute. Within the module everything is allowed.
6
! Outside (use-associated): For pointers, their association status
7
! may not be changed. For nonpointers, their value may not be changed.
8
!
9
! Test of a valid code
10
 
11
module protmod
12
  implicit none
13
  integer          :: a,b
14
  integer, target  :: at,bt
15
  integer, pointer :: ap,bp
16
  protected :: a, at
17
  protected :: ap
18
contains
19
  subroutine setValue()
20
    a = 43
21
    ap => null()
22
    nullify(ap)
23
    ap => at
24
    ap = 3
25
    allocate(ap)
26
    ap = 73
27
    call increment(a,ap,at)
28
    if(a /= 44 .or. ap /= 74 .or. at /= 4) call abort()
29
  end subroutine setValue
30
  subroutine increment(a1,a2,a3)
31
    integer, intent(inout) :: a1, a2, a3
32
    a1 = a1 + 1
33
    a2 = a2 + 1
34
    a3 = a3 + 1
35
  end subroutine increment
36
end module protmod
37
 
38
program main
39
  use protmod
40
  implicit none
41
  b = 5
42
  bp => bt
43
  bp = 4
44
  bt = 7
45
  call setValue()
46
  if(a /= 44 .or. ap /= 74 .or. at /= 4) call abort()
47
  call plus5(ap)
48
  if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
49
  call checkVal(a,ap,at)
50
contains
51
  subroutine plus5(j)
52
    integer, intent(inout) :: j
53
    j = j + 5
54
  end subroutine plus5
55
  subroutine checkVal(x,y,z)
56
    integer, intent(in) :: x, y, z
57
    if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
58
  end subroutine
59
end program main
60
 
61
! { dg-final { cleanup-modules "protmod" } }

powered by: WebSVN 2.1.0

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