diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -490,6 +490,14 @@ "non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute"_err_en_US); } } + } else if (symbol.attrs().test(Attr::INTENT_IN) || + symbol.attrs().test(Attr::INTENT_OUT) || + symbol.attrs().test(Attr::INTENT_INOUT)) { + messages_.Say("INTENT attributes may apply only to a dummy " + "argument"_err_en_US); // C843 + } else if (IsOptional(symbol)) { + messages_.Say("OPTIONAL attribute may apply only to a dummy " + "argument"_err_en_US); // C849 } if (IsStaticallyInitialized(symbol, true /* ignore DATA inits */)) { // C808 CheckPointerInitialization(symbol); @@ -618,8 +626,9 @@ } else if (isAssumedRank) { // C837 msg = "Assumed-rank array '%s' must be a dummy argument"_err_en_US; } else if (isImplied) { - if (!IsNamedConstant(symbol)) { // C836 - msg = "Implied-shape array '%s' must be a named constant"_err_en_US; + if (!IsNamedConstant(symbol)) { // C835, C836 + msg = "Implied-shape array '%s' must be a named constant or a " + "dummy argument"_err_en_US; } } else if (IsNamedConstant(symbol)) { if (!isExplicit && !isImplied) { @@ -664,6 +673,14 @@ // function SIN as an actual argument. messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US); } + } else if (symbol.attrs().test(Attr::INTENT_IN) || + symbol.attrs().test(Attr::INTENT_OUT) || + symbol.attrs().test(Attr::INTENT_INOUT)) { + messages_.Say("INTENT attributes may apply only to a dummy " + "argument"_err_en_US); // C843 + } else if (IsOptional(symbol)) { + messages_.Say("OPTIONAL attribute may apply only to a dummy " + "argument"_err_en_US); // C849 } else if (symbol.owner().IsDerivedType()) { if (!symbol.attrs().test(Attr::POINTER)) { // C756 const auto &name{symbol.name()}; diff --git a/flang/test/Semantics/resolve58.f90 b/flang/test/Semantics/resolve58.f90 --- a/flang/test/Semantics/resolve58.f90 +++ b/flang/test/Semantics/resolve58.f90 @@ -27,8 +27,8 @@ subroutine s3(a, b) real :: a(*) !ERROR: Dummy array argument 'b' may not have implied shape - real :: b(*,*) ! C836 - !ERROR: Implied-shape array 'c' must be a named constant + real :: b(*,*) ! C835, C836 + !ERROR: Implied-shape array 'c' must be a named constant or a dummy argument real :: c(*) ! C836 !ERROR: Named constant 'd' array must have constant or implied shape integer, parameter :: d(:) = [1, 2, 3] @@ -56,3 +56,25 @@ allocatable :: a allocatable :: b end subroutine + +subroutine s6() +!C835 An object whose array bounds are specified by an +! implied-shape-or-assumed-size-spec shall be a dummy data object or a named +! constant. +! +!C843 An entity with the INTENT attribute shall be a dummy data object or a +! dummy procedure pointer. +! +!C849 An entity with the OPTIONAL attribute shall be a dummy argument. + + !ERROR: Implied-shape array 'local1' must be a named constant or a dummy argument + real, dimension (*) :: local1 + !ERROR: INTENT attributes may apply only to a dummy argument + real, intent(in) :: local2 + !ERROR: INTENT attributes may apply only to a dummy argument + procedure(), intent(in) :: p1 + !ERROR: OPTIONAL attribute may apply only to a dummy argument + real, optional :: local3 + !ERROR: OPTIONAL attribute may apply only to a dummy argument + procedure(), optional :: p2 +end subroutine diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -109,10 +109,10 @@ real, intent(out) :: y real :: z end - !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body module subroutine s2(x, z) real, intent(in) :: x - real, intent(out) :: y + !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body + real, intent(out) :: z end module subroutine s3(x, y) !ERROR: Dummy argument 'x' is a procedure; the corresponding argument in the interface body is not