230 lines · plain
1! RUN: %flang_fc1 -fdebug-unparse-with-symbols -DSTRICT_F18 -pedantic %s 2>&1 | FileCheck %s2! RUN: %flang_fc1 -fdebug-unparse-with-symbols -DARCHAIC_FORTRAN %s 2>&1 | FileCheck %s3! 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 tests7! define STRICT_F18 to eliminate tests of features not in F188! define ARCHAIC_FORTRAN to add test of feature found in Fortran before F959 10subroutine sub00(a,b,n,m)11 integer :: n, m12 real a(n)13 real :: b(m)141 print *, n, m151234 print *, a(n), b(1)1699999 print *, a(1), b(m)17end subroutine sub0018 19subroutine do_loop01(a,n)20 integer :: n21 real, dimension(n) :: a22 do 10 i = 1, n23 print *, i, a(i)2410 continue25end subroutine do_loop0126 27subroutine do_loop02(a,n)28 integer :: n29 real, dimension(n,n) :: a30 do 10 j = 1, n31 do 10 i = 1, n32 print *, i, j, a(i, j)3310 continue34end subroutine do_loop0235 36#ifndef STRICT_F1837subroutine do_loop03(a,n)38 integer :: n39 real, dimension(n) :: a40 do 10 i = 1, n4110 print *, i, a(i) ! extension (not f18)42end subroutine do_loop0343 44subroutine do_loop04(a,n)45 integer :: n46 real :: a(n,n)47 do 10 j = 1, n48 do 10 i = 1, n4910 print *, i, j, a(i, j) ! extension (not f18)50end subroutine do_loop0451 52subroutine do_loop05(a,n)53 integer :: n54 real a(n,n,n)55 do 10 k = 1, n56 do 10 j = 1, n57 do 10 i = 1, n5810 print *, a(i, j, k) ! extension (not f18)59end subroutine do_loop0560#endif61 62subroutine do_loop06(a,n)63 integer :: n64 real, dimension(n) :: a65 loopname: do i = 1, n66 print *, i, a(i)67 if (i .gt. 50) then68678 exit69 end if70 end do loopname71end subroutine do_loop0672 73subroutine do_loop07(a,n)74 integer :: n75 real, dimension(n,n) :: a76 loopone: do j = 1, n77 looptwo: do i = 1, n78 print *, i, j, a(i, j)79 end do looptwo80 end do loopone81end subroutine do_loop0782 83#ifndef STRICT_F1884subroutine do_loop08(a,b,n,m,nn)85 integer :: n, m, nn86 real, dimension(n,n) :: a87 real b(m,nn)88 loopone: do j = 1, n89 condone: if (m .lt. n) then90 looptwo: do i = 1, m91 condtwo: if (n .lt. nn) then92 b(m-i,j) = s(m-i,j)93 if (i .eq. j) then94 goto 11195 end if96 else97 cycle loopone98 end if condtwo99 end do looptwo100 else if (n .lt. m) then101 loopthree: do i = 1, n102 condthree: if (n .lt. nn) then103 a(i,j) = b(i,j)104 if (i .eq. j) then105 return106 end if107 else108 exit loopthree109 end if condthree110 end do loopthree111 end if condone112 end do loopone113111 print *, "done"114end subroutine do_loop08115#endif116 117#ifndef STRICT_F18118! extended ranges supported by PGI, gfortran gives warnings119subroutine do_loop09(a,n,j)120 integer :: n121 real a(n)122 goto 400123200 print *, "found the index", j124 print *, "value at", j, "is", a(j)125 goto 300 ! FIXME: emits diagnostic even without -pedantic126400 do 100 i = 1, n127 if (i .eq. j) then128 goto 200 ! extension: extended GOTO ranges129300 continue130 else131 print *, a(i)132 end if133100 end do134500 continue135end subroutine do_loop09136#endif137 138subroutine goto10(a,b,n)139 dimension :: a(3), b(3)140 goto 1014110 print *,"x"1424 labelit: if (a(n-1) .ne. b(n-2)) then143 goto 567144 end if labelit145567 end subroutine goto10146 147subroutine computed_goto11(i,j,k)148 goto (100,110,120) i149100 print *, j150 goto 200151110 print *, k152 goto 200153120 print *, -1154200 end subroutine computed_goto11155 156#ifndef STRICT_F18157subroutine arith_if12(i)158 if (i) 300,310,320159300 continue160 print *,"<"161 goto 340162310 print *,"=="163340 goto 330164320 print *,">"165330 goto 350166350 continue167end subroutine arith_if12168#endif169 170#ifndef STRICT_F18171subroutine alt_return_spec13(i,*,*,*)1729 continue1738 labelme: if (i .lt. 42) then1747 return 11756 else if (i .lt. 94) then1765 return 21774 else if (i .lt. 645) then1783 return 31792 end if labelme1801 end subroutine alt_return_spec13181 182subroutine alt_return_spec14(i)183 call alt_return_spec13(i,*6000,*6130,*6457)184 print *, "Hi!"1856000 continue1866100 print *,"123"1876130 continue1886400 print *,"abc"1896457 continue1906650 print *,"!@#"191end subroutine alt_return_spec14192#endif193 194#ifndef STRICT_F18195subroutine specifiers15(a,b,x)196 integer x197 OPEN (10, file="myfile.dat", err=100)198 READ (10,20,end=200,size=x,advance='no',eor=300) a199 goto 9920099 CLOSE (10)201 goto 40202100 print *,"error opening"203101 return204200 print *,"end of file"205202 return206300 print *, "end of record"207303 return20820 FORMAT (1x,F5.1)20930 FORMAT (2x,F6.2)21040 OPEN (11, file="myfile2.dat", err=100)211 goto 5021250 WRITE (11,30,err=100) b213 CLOSE (11)214end subroutine specifiers15215#endif216 217#if !defined(STRICT_F18) && defined(ARCHAIC_FORTRAN)218! assigned goto was deleted in F95. PGI supports, gfortran gives warnings219subroutine assigned_goto16220 assign 10 to i221 goto i (10, 20, 30)22210 continue223 assign 20 to i22420 continue225 assign 30 to i22630 pause227 print *, "archaic feature!"228end subroutine assigned_goto16229#endif230