1! RUN: %f18 -funparse-with-symbols -DSTRICT_F18 -Mstandard %s 2>&1 | FileCheck %s
2! RUN: %f18 -funparse-with-symbols -DARCHAIC_FORTRAN %s 2>&1 | FileCheck %s
3! CHECK-NOT: :{{[[:space:]]}}error:{{[[:space:]]}}
4! FIXME: the above check line does not work because diags are not emitted with error: in them.
5
6! these are the conformance tests
7! define STRICT_F18 to eliminate tests of features not in F18
8! define ARCHAIC_FORTRAN to add test of feature found in Fortran before F95
9
10subroutine sub00(a,b,n,m)
11  integer :: n, m
12  real a(n)
13  real :: b(m)
141 print *, n, m
151234 print *, a(n), b(1)
1699999 print *, a(1), b(m)
17end subroutine sub00
18
19subroutine do_loop01(a,n)
20  integer :: n
21  real, dimension(n) :: a
22  do 10 i = 1, n
23     print *, i, a(i)
2410   continue
25end subroutine do_loop01
26
27subroutine do_loop02(a,n)
28  integer :: n
29  real, dimension(n,n) :: a
30  do 10 j = 1, n
31     do 10 i = 1, n
32        print *, i, j, a(i, j)
3310      continue
34end subroutine do_loop02
35
36#ifndef STRICT_F18
37subroutine do_loop03(a,n)
38  integer :: n
39  real, dimension(n) :: a
40  do 10 i = 1, n
4110   print *, i, a(i)		! extension (not f18)
42end subroutine do_loop03
43
44subroutine do_loop04(a,n)
45  integer :: n
46  real :: a(n,n)
47  do 10 j = 1, n
48     do 10 i = 1, n
4910      print *, i, j, a(i, j)	! extension (not f18)
50end subroutine do_loop04
51
52subroutine do_loop05(a,n)
53  integer :: n
54  real a(n,n,n)
55  do 10 k = 1, n
56     do 10 j = 1, n
57        do 10 i = 1, n
5810         print *, a(i, j, k)	! extension (not f18)
59end subroutine do_loop05
60#endif
61
62subroutine do_loop06(a,n)
63  integer :: n
64  real, dimension(n) :: a
65  loopname: do i = 1, n
66     print *, i, a(i)
67     if (i .gt. 50) then
68678     exit
69     end if
70  end do loopname
71end subroutine do_loop06
72
73subroutine do_loop07(a,n)
74  integer :: n
75  real, dimension(n,n) :: a
76  loopone: do j = 1, n
77     looptwo: do i = 1, n
78        print *, i, j, a(i, j)
79     end do looptwo
80  end do loopone
81end subroutine do_loop07
82
83#ifndef STRICT_F18
84subroutine do_loop08(a,b,n,m,nn)
85  integer :: n, m, nn
86  real, dimension(n,n) :: a
87  real b(m,nn)
88  loopone: do j = 1, n
89     condone: if (m .lt. n) then
90        looptwo: do i = 1, m
91           condtwo: if (n .lt. nn) then
92              b(m-i,j) = s(m-i,j)
93              if (i .eq. j) then
94                 goto 111
95              end if
96           else
97              cycle loopone
98           end if condtwo
99        end do looptwo
100     else if (n .lt. m) then
101        loopthree: do i = 1, n
102           condthree: if (n .lt. nn) then
103              a(i,j) = b(i,j)
104              if (i .eq. j) then
105                 return
106              end if
107           else
108              exit loopthree
109           end if condthree
110        end do loopthree
111     end if condone
112  end do loopone
113111 print *, "done"
114end subroutine do_loop08
115#endif
116
117#ifndef STRICT_F18
118! extended ranges supported by PGI, gfortran gives warnings
119subroutine do_loop09(a,n,j)
120  integer :: n
121  real a(n)
122  goto 400
123200 print *, "found the index", j
124  print *, "value at", j, "is", a(j)
125  goto 300 ! FIXME: emits diagnostic even without -Mstandard
126400  do 100 i = 1, n
127     if (i .eq. j) then
128        goto 200	! extension: extended GOTO ranges
129300     continue
130     else
131        print *, a(i)
132     end if
133100 end do
134500 continue
135end subroutine do_loop09
136#endif
137
138subroutine goto10(a,b,n)
139  dimension :: a(3), b(3)
140  goto 10
14110 print *,"x"
1424 labelit: if (a(n-1) .ne. b(n-2)) then
143     goto 567
144  end if labelit
145567 end subroutine goto10
146
147subroutine computed_goto11(i,j,k)
148  goto (100,110,120) i
149100 print *, j
150  goto 200
151110 print *, k
152  goto 200
153120 print *, -1
154200 end subroutine computed_goto11
155
156#ifndef STRICT_F18
157subroutine arith_if12(i)
158  if (i) 300,310,320
159300 continue
160  print *,"<"
161  goto 340
162310 print *,"=="
163340 goto 330
164320 print *,">"
165330 goto 350
166350 continue
167end subroutine arith_if12
168#endif
169
170#ifndef STRICT_F18
171subroutine alt_return_spec13(i,*,*,*)
1729 continue
1738 labelme: if (i .lt. 42) then
1747  return 1
1756 else if (i .lt. 94) then
1765  return 2
1774 else if (i .lt. 645) then
1783  return 3
1792 end if labelme
1801 end subroutine alt_return_spec13
181
182subroutine alt_return_spec14(i)
183  call alt_return_spec13(i,*6000,*6130,*6457)
184  print *, "Hi!"
1856000 continue
1866100 print *,"123"
1876130 continue
1886400 print *,"abc"
1896457 continue
1906650 print *,"!@#"
191end subroutine alt_return_spec14
192#endif
193
194#ifndef STRICT_F18
195subroutine specifiers15(a,b,x)
196  integer x
197  OPEN (10, file="myfile.dat", err=100)
198  READ (10,20,end=200,size=x,advance='no',eor=300) a
199  goto 99
20099 CLOSE (10)
201  goto 40
202100 print *,"error opening"
203101 return
204200 print *,"end of file"
205202 return
206300 print *, "end of record"
207303 return
20820 FORMAT (1x,F5.1)
20930 FORMAT (2x,F6.2)
21040 OPEN (11, file="myfile2.dat", err=100)
211  goto 50
21250 WRITE (11,30,err=100) b
213  CLOSE (11)
214end subroutine specifiers15
215#endif
216
217#if !defined(STRICT_F18) && defined(ARCHAIC_FORTRAN)
218! assigned goto was deleted in F95. PGI supports, gfortran gives warnings
219subroutine assigned_goto16
220  assign 10 to i
221  goto i (10, 20, 30)
22210 continue
223  assign 20 to i
22420 continue
225  assign 30 to i
22630 pause
227  print *, "archaic feature!"
228end subroutine assigned_goto16
229#endif
230