1! { 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
12module protmod
13  implicit none
14  integer          :: a
15  integer, target  :: at
16  integer, pointer :: ap
17  protected :: a, at, ap
18end module protmod
19
20program 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)
36contains
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
51end program main
52
53module test
54  real :: a
55  protected :: test ! { dg-error "MODULE attribute conflicts with PROTECTED" }
56end module test
57