Files
RedBear-OS/local/recipes/dev/libclc/source/flang/test/Semantics/label01.F90
T
vasilito cb424d7448 build: static patch-sanity linter (shift-left the malformed-patch class)
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).
2026-08-01 05:13:02 +03:00

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