vasilito
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).
196 lines
8.4 KiB
Fortran
196 lines
8.4 KiB
Fortran
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
|
|
! Test 15.5.2.9(2,3,5) dummy procedure requirements
|
|
! C843
|
|
! An entity with the INTENT attribute shall be a dummy data object or a
|
|
! dummy procedure pointer.
|
|
|
|
module m
|
|
contains
|
|
|
|
integer function intfunc(x)
|
|
integer, intent(in) :: x
|
|
intfunc = x
|
|
end function
|
|
real function realfunc(x)
|
|
real, intent(in) :: x
|
|
realfunc = x
|
|
end function
|
|
|
|
subroutine s01(p)
|
|
procedure(realfunc), pointer, intent(in) :: p
|
|
end subroutine
|
|
subroutine s02(p)
|
|
procedure(realfunc), pointer :: p
|
|
end subroutine
|
|
subroutine s02b(p)
|
|
procedure(real), pointer :: p
|
|
end subroutine
|
|
subroutine s03(p)
|
|
procedure(realfunc) :: p
|
|
end subroutine
|
|
subroutine s04(p)
|
|
!ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
|
|
procedure(realfunc), intent(in) :: p
|
|
end subroutine
|
|
subroutine s05(p)
|
|
procedure(realfunc), pointer, intent(in out) :: p
|
|
end subroutine
|
|
|
|
subroutine selemental1(p)
|
|
!PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface [-Wportability]
|
|
procedure(cos) :: p ! ok
|
|
end subroutine
|
|
|
|
real elemental function elemfunc(x)
|
|
real, intent(in) :: x
|
|
elemfunc = x
|
|
end function
|
|
subroutine selemental2(p)
|
|
!ERROR: A dummy procedure may not be ELEMENTAL
|
|
procedure(elemfunc) :: p
|
|
end subroutine
|
|
|
|
function procptr()
|
|
procedure(realfunc), pointer :: procptr
|
|
procptr => realfunc
|
|
end function
|
|
function intprocptr()
|
|
procedure(intfunc), pointer :: intprocptr
|
|
intprocptr => intfunc
|
|
end function
|
|
|
|
subroutine test1 ! 15.5.2.9(5)
|
|
intrinsic :: sin
|
|
procedure(realfunc), pointer :: p
|
|
procedure(intfunc), pointer :: ip
|
|
integer, pointer :: intPtr
|
|
p => realfunc
|
|
ip => intfunc
|
|
call s01(realfunc) ! ok
|
|
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call s01(intfunc)
|
|
call s01(p) ! ok
|
|
call s01(procptr()) ! ok
|
|
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call s01(intprocptr())
|
|
call s01(null()) ! ok
|
|
call s01(null(p)) ! ok
|
|
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call s01(null(ip))
|
|
call s01(sin) ! ok
|
|
!ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
|
|
call s01(null(intPtr))
|
|
!ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
|
|
call s01(B"0101")
|
|
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
|
|
call s02(realfunc)
|
|
call s02(p) ! ok
|
|
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call s02(ip)
|
|
call s02(procptr()) ! believed to be ok
|
|
call s02(null()) ! ok
|
|
!ERROR: Actual argument associated with INTENT(IN OUT) procedure pointer dummy argument 'p=' is not definable
|
|
!BECAUSE: 'NULL()' is a null pointer
|
|
call s05(null())
|
|
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
|
|
call s02(sin)
|
|
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
|
|
call s02b(realfunc)
|
|
call s02b(p) ! ok
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'p=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call s02b(ip)
|
|
call s02b(procptr()) ! believed to be ok
|
|
call s02b(null())
|
|
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' is not a procedure pointer
|
|
call s02b(sin)
|
|
end subroutine
|
|
|
|
subroutine callsub(s)
|
|
call s
|
|
end subroutine
|
|
subroutine takesrealfunc1(f)
|
|
external f
|
|
real f
|
|
end subroutine
|
|
subroutine takesrealfunc2(f)
|
|
x = f(1)
|
|
end subroutine
|
|
subroutine forwardproc(p)
|
|
implicit none
|
|
external :: p ! function or subroutine not known
|
|
call foo(p)
|
|
end subroutine
|
|
|
|
subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3)
|
|
external :: unknown, ds, drf, dif
|
|
real :: drf
|
|
integer :: dif
|
|
procedure(callsub), pointer :: ps
|
|
procedure(realfunc), pointer :: prf
|
|
procedure(intfunc), pointer :: pif
|
|
call ds ! now we know that's it's a subroutine
|
|
call callsub(callsub) ! ok apart from infinite recursion
|
|
call callsub(unknown) ! ok
|
|
call callsub(ds) ! ok
|
|
call callsub(ps) ! ok
|
|
call takesrealfunc1(realfunc) ! ok
|
|
call takesrealfunc1(unknown) ! ok
|
|
call takesrealfunc1(drf) ! ok
|
|
call takesrealfunc1(prf) ! ok
|
|
call takesrealfunc2(realfunc) ! ok
|
|
call takesrealfunc2(unknown) ! ok
|
|
call takesrealfunc2(drf) ! ok
|
|
call takesrealfunc2(prf) ! ok
|
|
call forwardproc(callsub) ! ok
|
|
call forwardproc(realfunc) ! ok
|
|
call forwardproc(intfunc) ! ok
|
|
call forwardproc(unknown) ! ok
|
|
call forwardproc(ds) ! ok
|
|
call forwardproc(drf) ! ok
|
|
call forwardproc(dif) ! ok
|
|
call forwardproc(ps) ! ok
|
|
call forwardproc(prf) ! ok
|
|
call forwardproc(pif) ! ok
|
|
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
|
|
call callsub(realfunc)
|
|
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
|
|
call callsub(intfunc)
|
|
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
|
|
call callsub(drf)
|
|
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
|
|
call callsub(dif)
|
|
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
|
|
call callsub(prf)
|
|
!ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
|
|
call callsub(pif)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
|
|
call takesrealfunc1(callsub)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
|
|
call takesrealfunc1(ds)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
|
|
call takesrealfunc1(ps)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc1(intfunc)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc1(dif)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc1(pif)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc1(intfunc)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
|
|
call takesrealfunc2(callsub)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
|
|
call takesrealfunc2(ds)
|
|
!ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
|
|
call takesrealfunc2(ps)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc2(intfunc)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc2(dif)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc2(pif)
|
|
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
|
|
call takesrealfunc2(intfunc)
|
|
end subroutine
|
|
end module
|