1! { dg-do compile }
2!
3! PR fortran/54958
4!
5module m
6  integer, protected :: i
7  integer :: j
8end module m
9
10subroutine test1()
11  use m
12  implicit none
13  integer :: A(5)
14  ! Valid: data-implied-do (has a scope of the statement or construct)
15  DATA (A(i), i=1,5)/5*42/ ! OK
16
17  ! Valid: ac-implied-do (has a scope of the statement or construct)
18  print *, [(i, i=1,5 )] ! OK
19
20  ! Valid: index-name (has a scope of the statement or construct)
21  forall (i = 1:5) ! OK
22  end forall
23
24  ! Valid: index-name (has a scope of the statement or construct)
25  do concurrent (i = 1:5) ! OK
26  end do
27
28  ! Invalid: io-implied-do
29  print *, (i, i=1,5 ) ! { dg-error "PROTECTED and can not appear in a variable definition context .iterator variable." }
30
31  ! Invalid: do-variable in a do-stmt
32  do i = 1, 5 ! { dg-error "PROTECTED and can not appear in a variable definition context .iterator variable." }
33  end do
34end subroutine test1
35
36subroutine test2(i)
37  implicit none
38  integer, intent(in) :: i
39  integer :: A(5)
40  ! Valid: data-implied-do (has a scope of the statement or construct)
41  DATA (A(i), i=1,5)/5*42/ ! OK
42
43  ! Valid: ac-implied-do (has a scope of the statement or construct)
44  print *, [(i, i=1,5 )] ! OK
45
46  ! Valid: index-name (has a scope of the statement or construct)
47  forall (i = 1:5) ! OK
48  end forall
49
50  ! Valid: index-name (has a scope of the statement or construct)
51  do concurrent (i = 1:5) ! OK
52  end do
53
54  ! Invalid: io-implied-do
55  print *, (i, i=1,5 ) ! { dg-error "INTENT.IN. in variable definition context .iterator variable." }
56
57  ! Invalid: do-variable in a do-stmt
58  do i = 1, 5 ! { dg-error "INTENT.IN. in variable definition context .iterator variable." }
59  end do
60end subroutine test2
61
62pure subroutine test3()
63  use m
64  implicit none
65  integer :: A(5)
66  !DATA (A(j), j=1,5)/5*42/ ! Not allowed in pure
67
68  ! Valid: ac-implied-do (has a scope of the statement or construct)
69  A = [(j, j=1,5 )] ! OK
70
71  ! Valid: index-name (has a scope of the statement or construct)
72  forall (j = 1:5) ! OK
73  end forall
74
75  ! Valid: index-name (has a scope of the statement or construct)
76  do concurrent (j = 1:5) ! OK
77  end do
78
79  ! print *, (j, j=1,5 ) ! I/O not allowed in PURE
80
81  ! Invalid: do-variable in a do-stmt
82  do j = 1, 5 ! { dg-error "variable definition context .iterator variable. at .1. in PURE procedure" }
83  end do
84end subroutine test3
85