cb424d7448
verify-patch-sanity.py validates every active recipe .patch has internally- consistent hunk line counts — catching the 'malformed patch at line N' failure at commit/CI/preflight time instead of hours into a cook. This cycle hit that class three times (qtwaylandscanner, sddm, xwayland), each only discovered when cookbook tried to apply the patch. Running it across the repo found 29 latent malformed patches (validated against GNU patch: e.g. relibc/P3-sysv-ipc reproduces 'malformed patch at line 22'). They were harmless only because they sit in vendored recipes (baked, not re- applied) — but would fail on any version-bump re-derivation. --fix recounts the hunk headers (body untouched) and repaired all 29. Wired into build-preflight.sh (Phase 1.0D) and redbear-ci.yml, with a unit test (test-patch-sanity.sh). Skips archived/legacy trees and unvalidatable formats (empty placeholders, bare-@@ git hunks).
230 lines
5.0 KiB
Fortran
230 lines
5.0 KiB
Fortran
! RUN: %flang_fc1 -fdebug-unparse-with-symbols -DSTRICT_F18 -pedantic %s 2>&1 | FileCheck %s
|
|
! RUN: %flang_fc1 -fdebug-unparse-with-symbols -DARCHAIC_FORTRAN %s 2>&1 | FileCheck %s
|
|
! CHECK-NOT: :{{[[:space:]]}}error:{{[[:space:]]}}
|
|
! FIXME: the above check line does not work because diags are not emitted with error: in them.
|
|
|
|
! these are the conformance tests
|
|
! define STRICT_F18 to eliminate tests of features not in F18
|
|
! define ARCHAIC_FORTRAN to add test of feature found in Fortran before F95
|
|
|
|
subroutine sub00(a,b,n,m)
|
|
integer :: n, m
|
|
real a(n)
|
|
real :: b(m)
|
|
1 print *, n, m
|
|
1234 print *, a(n), b(1)
|
|
99999 print *, a(1), b(m)
|
|
end subroutine sub00
|
|
|
|
subroutine do_loop01(a,n)
|
|
integer :: n
|
|
real, dimension(n) :: a
|
|
do 10 i = 1, n
|
|
print *, i, a(i)
|
|
10 continue
|
|
end subroutine do_loop01
|
|
|
|
subroutine do_loop02(a,n)
|
|
integer :: n
|
|
real, dimension(n,n) :: a
|
|
do 10 j = 1, n
|
|
do 10 i = 1, n
|
|
print *, i, j, a(i, j)
|
|
10 continue
|
|
end subroutine do_loop02
|
|
|
|
#ifndef STRICT_F18
|
|
subroutine do_loop03(a,n)
|
|
integer :: n
|
|
real, dimension(n) :: a
|
|
do 10 i = 1, n
|
|
10 print *, i, a(i) ! extension (not f18)
|
|
end subroutine do_loop03
|
|
|
|
subroutine do_loop04(a,n)
|
|
integer :: n
|
|
real :: a(n,n)
|
|
do 10 j = 1, n
|
|
do 10 i = 1, n
|
|
10 print *, i, j, a(i, j) ! extension (not f18)
|
|
end subroutine do_loop04
|
|
|
|
subroutine do_loop05(a,n)
|
|
integer :: n
|
|
real a(n,n,n)
|
|
do 10 k = 1, n
|
|
do 10 j = 1, n
|
|
do 10 i = 1, n
|
|
10 print *, a(i, j, k) ! extension (not f18)
|
|
end subroutine do_loop05
|
|
#endif
|
|
|
|
subroutine do_loop06(a,n)
|
|
integer :: n
|
|
real, dimension(n) :: a
|
|
loopname: do i = 1, n
|
|
print *, i, a(i)
|
|
if (i .gt. 50) then
|
|
678 exit
|
|
end if
|
|
end do loopname
|
|
end subroutine do_loop06
|
|
|
|
subroutine do_loop07(a,n)
|
|
integer :: n
|
|
real, dimension(n,n) :: a
|
|
loopone: do j = 1, n
|
|
looptwo: do i = 1, n
|
|
print *, i, j, a(i, j)
|
|
end do looptwo
|
|
end do loopone
|
|
end subroutine do_loop07
|
|
|
|
#ifndef STRICT_F18
|
|
subroutine do_loop08(a,b,n,m,nn)
|
|
integer :: n, m, nn
|
|
real, dimension(n,n) :: a
|
|
real b(m,nn)
|
|
loopone: do j = 1, n
|
|
condone: if (m .lt. n) then
|
|
looptwo: do i = 1, m
|
|
condtwo: if (n .lt. nn) then
|
|
b(m-i,j) = s(m-i,j)
|
|
if (i .eq. j) then
|
|
goto 111
|
|
end if
|
|
else
|
|
cycle loopone
|
|
end if condtwo
|
|
end do looptwo
|
|
else if (n .lt. m) then
|
|
loopthree: do i = 1, n
|
|
condthree: if (n .lt. nn) then
|
|
a(i,j) = b(i,j)
|
|
if (i .eq. j) then
|
|
return
|
|
end if
|
|
else
|
|
exit loopthree
|
|
end if condthree
|
|
end do loopthree
|
|
end if condone
|
|
end do loopone
|
|
111 print *, "done"
|
|
end subroutine do_loop08
|
|
#endif
|
|
|
|
#ifndef STRICT_F18
|
|
! extended ranges supported by PGI, gfortran gives warnings
|
|
subroutine do_loop09(a,n,j)
|
|
integer :: n
|
|
real a(n)
|
|
goto 400
|
|
200 print *, "found the index", j
|
|
print *, "value at", j, "is", a(j)
|
|
goto 300 ! FIXME: emits diagnostic even without -pedantic
|
|
400 do 100 i = 1, n
|
|
if (i .eq. j) then
|
|
goto 200 ! extension: extended GOTO ranges
|
|
300 continue
|
|
else
|
|
print *, a(i)
|
|
end if
|
|
100 end do
|
|
500 continue
|
|
end subroutine do_loop09
|
|
#endif
|
|
|
|
subroutine goto10(a,b,n)
|
|
dimension :: a(3), b(3)
|
|
goto 10
|
|
10 print *,"x"
|
|
4 labelit: if (a(n-1) .ne. b(n-2)) then
|
|
goto 567
|
|
end if labelit
|
|
567 end subroutine goto10
|
|
|
|
subroutine computed_goto11(i,j,k)
|
|
goto (100,110,120) i
|
|
100 print *, j
|
|
goto 200
|
|
110 print *, k
|
|
goto 200
|
|
120 print *, -1
|
|
200 end subroutine computed_goto11
|
|
|
|
#ifndef STRICT_F18
|
|
subroutine arith_if12(i)
|
|
if (i) 300,310,320
|
|
300 continue
|
|
print *,"<"
|
|
goto 340
|
|
310 print *,"=="
|
|
340 goto 330
|
|
320 print *,">"
|
|
330 goto 350
|
|
350 continue
|
|
end subroutine arith_if12
|
|
#endif
|
|
|
|
#ifndef STRICT_F18
|
|
subroutine alt_return_spec13(i,*,*,*)
|
|
9 continue
|
|
8 labelme: if (i .lt. 42) then
|
|
7 return 1
|
|
6 else if (i .lt. 94) then
|
|
5 return 2
|
|
4 else if (i .lt. 645) then
|
|
3 return 3
|
|
2 end if labelme
|
|
1 end subroutine alt_return_spec13
|
|
|
|
subroutine alt_return_spec14(i)
|
|
call alt_return_spec13(i,*6000,*6130,*6457)
|
|
print *, "Hi!"
|
|
6000 continue
|
|
6100 print *,"123"
|
|
6130 continue
|
|
6400 print *,"abc"
|
|
6457 continue
|
|
6650 print *,"!@#"
|
|
end subroutine alt_return_spec14
|
|
#endif
|
|
|
|
#ifndef STRICT_F18
|
|
subroutine specifiers15(a,b,x)
|
|
integer x
|
|
OPEN (10, file="myfile.dat", err=100)
|
|
READ (10,20,end=200,size=x,advance='no',eor=300) a
|
|
goto 99
|
|
99 CLOSE (10)
|
|
goto 40
|
|
100 print *,"error opening"
|
|
101 return
|
|
200 print *,"end of file"
|
|
202 return
|
|
300 print *, "end of record"
|
|
303 return
|
|
20 FORMAT (1x,F5.1)
|
|
30 FORMAT (2x,F6.2)
|
|
40 OPEN (11, file="myfile2.dat", err=100)
|
|
goto 50
|
|
50 WRITE (11,30,err=100) b
|
|
CLOSE (11)
|
|
end subroutine specifiers15
|
|
#endif
|
|
|
|
#if !defined(STRICT_F18) && defined(ARCHAIC_FORTRAN)
|
|
! assigned goto was deleted in F95. PGI supports, gfortran gives warnings
|
|
subroutine assigned_goto16
|
|
assign 10 to i
|
|
goto i (10, 20, 30)
|
|
10 continue
|
|
assign 20 to i
|
|
20 continue
|
|
assign 30 to i
|
|
30 pause
|
|
print *, "archaic feature!"
|
|
end subroutine assigned_goto16
|
|
#endif
|