[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:
Peter Steinfeld 2021-01-15 07:04:20 -08:00
parent be69e66b1c
commit 1e1a011b09
4 changed files with 22 additions and 7 deletions

View File

@ -632,6 +632,14 @@ void CheckHelper::CheckArraySpec(
void CheckHelper::CheckProcEntity(
const Symbol &symbol, const ProcEntityDetails &details) {
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()};
if (!symbol.attrs().test(Attr::INTRINSIC) &&
(symbol.attrs().test(Attr::ELEMENTAL) ||

View File

@ -42,7 +42,7 @@ contains
! C1030 and 10.2.2.4 - procedure names as target of procedure pointer
subroutine s4(s_dummy)
procedure(s), intent(in) :: s_dummy
procedure(s) :: s_dummy
procedure(s), pointer :: p, q
procedure(), pointer :: r
integer :: i

View File

@ -1,5 +1,8 @@
! RUN: %S/test_errors.sh %s %t %f18
! 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
@ -22,6 +25,10 @@ module m
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 selemental1(p)
procedure(cos) :: p ! ok

View File

@ -157,9 +157,9 @@ end
module m3
interface
module subroutine s1(x, y, z)
procedure(real), intent(in) :: x
procedure(real), intent(out) :: y
procedure(real), intent(out) :: z
procedure(real), pointer, intent(in) :: x
procedure(real), pointer, intent(out) :: y
procedure(real), pointer, intent(out) :: z
end
module subroutine s2(x, y)
procedure(real), pointer :: x
@ -171,11 +171,11 @@ end
submodule(m3) sm3
contains
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
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
procedure(real) :: z
procedure(real), pointer :: z
end
module subroutine s2(x, y)
!ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not