Files
RedBear-OS/local/recipes/dev/libclc/source/flang/test/Semantics/call01.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

145 lines
3.9 KiB
Fortran

! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Confirm enforcement of constraints and restrictions in 15.6.2.1
non_recursive function f01(n) result(res)
integer, value :: n
integer :: res
if (n <= 0) then
res = n
else
!ERROR: NON_RECURSIVE procedure 'f01' cannot call itself
res = n * f01(n-1) ! 15.6.2.1(3)
end if
end function
non_recursive function f02(n) result(res)
integer, value :: n
integer :: res
if (n <= 0) then
res = n
else
res = nested()
end if
contains
integer function nested()
!ERROR: NON_RECURSIVE procedure 'f02' cannot call itself
nested = n * f02(n-1) ! 15.6.2.1(3)
end function nested
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
recursive character(*) function f03(n) ! C723
integer, value :: n
f03 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
recursive function f04(n) result(res) ! C723
integer, value :: n
character(*) :: res
res = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return an array
character(*) function f05()
dimension :: f05(1) ! C723
f05(1) = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return an array
function f06()
character(*) :: f06(1) ! C723
f06(1) = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
character(*) function f07()
pointer :: f07 ! C723
character, target :: a = ' '
f07 => a
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
function f08()
character(*), pointer :: f08 ! C723
character, target :: a = ' '
f08 => a
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be PURE
pure character(*) function f09() ! C723
f09 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be PURE
pure function f10()
character(*) :: f10 ! C723
f10 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
elemental character(*) function f11(n) ! C723
integer, value :: n
f11 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
elemental function f12(n)
character(*) :: f12 ! C723
integer, value :: n
f12 = ''
end function
function f13(n) result(res)
integer, value :: n
character(*) :: res
if (n <= 0) then
res = ''
else
!ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself
!ERROR: Assumed-length character function must be defined with a length to be called
res = f13(n-1) ! 15.6.2.1(3)
end if
end function
function f14(n) result(res)
integer, value :: n
character(*) :: res
if (n <= 0) then
res = ''
else
res = nested()
end if
contains
character(1) function nested()
!ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
!ERROR: Assumed-length character function must be defined with a length to be called
nested = f14(n-1) ! 15.6.2.1(3)
end function nested
end function
subroutine s01(f1, f2, fp1, fp2, fp3)
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type [-Wportability]
character*(*) :: f1, f3, fp1
external :: f1, f3
pointer :: fp1, fp3
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type [-Wportability]
procedure(character*(*)), pointer :: fp2
interface
character*(*) function f2()
end function
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type [-Wportability]
character*(*) function fp3()
end function
!ERROR: A function interface may not declare an assumed-length CHARACTER(*) result
character*(*) function f4()
end function
end interface
print *, f1()
print *, f2()
!ERROR: Assumed-length character function must be defined with a length to be called
print *, f3()
print *, fp1()
print *, fp2()
end subroutine