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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
! { dg-shouldfail "Invalid Fortran 2003 code" }
3
! { dg-options "-std=f2003 -fall-intrinsics" }
4
! PR fortran/23994
5
!
6
! Test PROTECTED attribute. Within the module everything is allowed.
7
! Outside (use-associated): For pointers, their association status
8
! may not be changed. For nonpointers, their value may not be changed.
9
!
10
! Test of a invalid code
11
 
12
module protmod
13
  implicit none
14
  integer          :: a
15
  integer, target  :: at
16
  integer, pointer :: ap
17
  protected :: a, at, ap
18
end module protmod
19
 
20
program main
21
  use protmod
22
  implicit none
23
  integer   :: j
24
  logical   :: asgnd
25
  protected :: j ! { dg-error "only allowed in specification part of a module" }
26
  a = 43       ! { dg-error "variable definition context" }
27
  ap => null() ! { dg-error "pointer association context" }
28
  nullify(ap)  ! { dg-error "pointer association context" }
29
  ap => at     ! { dg-error "pointer association context" }
30
  ap = 3       ! OK
31
  allocate(ap) ! { dg-error "pointer association context" }
32
  ap = 73      ! OK
33
  call increment(a,at) ! { dg-error "variable definition context" }
34
  call pointer_assignments(ap) ! { dg-error "pointer association context" }
35
  asgnd = pointer_check(ap)
36
contains
37
  subroutine increment(a1,a3)
38
    integer, intent(inout) :: a1, a3
39
    a1 = a1 + 1
40
    a3 = a3 + 1
41
  end subroutine increment
42
  subroutine pointer_assignments(p)
43
    integer, pointer,intent(out) :: p
44
    p => null()
45
  end subroutine pointer_assignments
46
  function pointer_check(p)
47
    integer, pointer,intent(in) :: p
48
    logical :: pointer_check
49
    pointer_check = associated(p)
50
  end function pointer_check
51
end program main
52
 
53
module test
54
  real :: a
55
  protected :: test ! { dg-error "MODULE attribute conflicts with PROTECTED" }
56
end module test
57
 
58
! { dg-final { cleanup-modules "protmod test" } }

powered by: WebSVN 2.1.0

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