[flang] Disallow INTENT attribute on procedure dummy arguments
C843 states that "An entity with the INTENT attribute shall be a dummy data object or a dummy procedure pointer." This change enforces that and fixes some tests that erroneously violated this rule. Differential Revision: https://reviews.llvm.org/D94781
This commit is contained in:
parent
be69e66b1c
commit
1e1a011b09
|
|
@ -632,6 +632,14 @@ void CheckHelper::CheckArraySpec(
|
||||||
void CheckHelper::CheckProcEntity(
|
void CheckHelper::CheckProcEntity(
|
||||||
const Symbol &symbol, const ProcEntityDetails &details) {
|
const Symbol &symbol, const ProcEntityDetails &details) {
|
||||||
if (details.isDummy()) {
|
if (details.isDummy()) {
|
||||||
|
if (!symbol.attrs().test(Attr::POINTER) && // C843
|
||||||
|
(symbol.attrs().test(Attr::INTENT_IN) ||
|
||||||
|
symbol.attrs().test(Attr::INTENT_OUT) ||
|
||||||
|
symbol.attrs().test(Attr::INTENT_INOUT))) {
|
||||||
|
messages_.Say("A dummy procedure without the POINTER attribute"
|
||||||
|
" may not have an INTENT attribute"_err_en_US);
|
||||||
|
}
|
||||||
|
|
||||||
const Symbol *interface{details.interface().symbol()};
|
const Symbol *interface{details.interface().symbol()};
|
||||||
if (!symbol.attrs().test(Attr::INTRINSIC) &&
|
if (!symbol.attrs().test(Attr::INTRINSIC) &&
|
||||||
(symbol.attrs().test(Attr::ELEMENTAL) ||
|
(symbol.attrs().test(Attr::ELEMENTAL) ||
|
||||||
|
|
|
||||||
|
|
@ -42,7 +42,7 @@ contains
|
||||||
|
|
||||||
! C1030 and 10.2.2.4 - procedure names as target of procedure pointer
|
! C1030 and 10.2.2.4 - procedure names as target of procedure pointer
|
||||||
subroutine s4(s_dummy)
|
subroutine s4(s_dummy)
|
||||||
procedure(s), intent(in) :: s_dummy
|
procedure(s) :: s_dummy
|
||||||
procedure(s), pointer :: p, q
|
procedure(s), pointer :: p, q
|
||||||
procedure(), pointer :: r
|
procedure(), pointer :: r
|
||||||
integer :: i
|
integer :: i
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,8 @@
|
||||||
! RUN: %S/test_errors.sh %s %t %f18
|
! RUN: %S/test_errors.sh %s %t %f18
|
||||||
! Test 15.5.2.9(2,3,5) dummy procedure requirements
|
! 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
|
module m
|
||||||
contains
|
contains
|
||||||
|
|
@ -22,6 +25,10 @@ module m
|
||||||
subroutine s03(p)
|
subroutine s03(p)
|
||||||
procedure(realfunc) :: p
|
procedure(realfunc) :: p
|
||||||
end subroutine
|
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 selemental1(p)
|
subroutine selemental1(p)
|
||||||
procedure(cos) :: p ! ok
|
procedure(cos) :: p ! ok
|
||||||
|
|
|
||||||
|
|
@ -157,9 +157,9 @@ end
|
||||||
module m3
|
module m3
|
||||||
interface
|
interface
|
||||||
module subroutine s1(x, y, z)
|
module subroutine s1(x, y, z)
|
||||||
procedure(real), intent(in) :: x
|
procedure(real), pointer, intent(in) :: x
|
||||||
procedure(real), intent(out) :: y
|
procedure(real), pointer, intent(out) :: y
|
||||||
procedure(real), intent(out) :: z
|
procedure(real), pointer, intent(out) :: z
|
||||||
end
|
end
|
||||||
module subroutine s2(x, y)
|
module subroutine s2(x, y)
|
||||||
procedure(real), pointer :: x
|
procedure(real), pointer :: x
|
||||||
|
|
@ -171,11 +171,11 @@ end
|
||||||
submodule(m3) sm3
|
submodule(m3) sm3
|
||||||
contains
|
contains
|
||||||
module subroutine s1(x, y, z)
|
module subroutine s1(x, y, z)
|
||||||
procedure(real), intent(in) :: x
|
procedure(real), pointer, intent(in) :: x
|
||||||
!ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body
|
!ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body
|
||||||
procedure(real), intent(inout) :: y
|
procedure(real), pointer, intent(inout) :: y
|
||||||
!ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body
|
!ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body
|
||||||
procedure(real) :: z
|
procedure(real), pointer :: z
|
||||||
end
|
end
|
||||||
module subroutine s2(x, y)
|
module subroutine s2(x, y)
|
||||||
!ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
|
!ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue