[flang] Check for attributes specific to dummy arguments

[PeteSteinfeld]

Summary

We were not checking that attributes that are supposed to be specific to
dummy arguments were not being used for local entities. I added the checks
along with tests for them.

After implementing these new checks, I found that one of the tests in
separate-mp02.f90 was erroneous, and I fixed it.

[tskeith]

flang/test/Semantics/resolve58.f90

78

There are already checks for the VALUE attribute, but the message is worded differently. It would be better if they were consistent.

t.f90:2:21: error: VALUE attribute may apply only to a dummy argument
    integer, value :: x
                      ^
t.f90:3:24: error: OPTIONAL attribute can only be used for dummy arguments
    integer, optional :: y
                         ^

[PeteSteinfeld]

Fixed the error messages as recommended by Tim.

flang/lib/Semantics/check-declarations.cpp

if (InPure() && !IsStmtFunction(DEREF(innermostSymbol_)) &&
             }
           }
         }
       } else if (!IsIntentInOut(symbol)) { // C1586
         messages_.Say(
             "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);
     if (IsAutomatic(symbol)) {
       messages_.Say(
           "An automatic variable or component must not be initialized"_err_en_US);
     } else if (IsDummy(symbol)) {
       messages_.Say("A dummy argument must not be initialized"_err_en_US);
if (symbol.test(Symbol::Flag::CrayPointee) && !isExplicit && !isAssumedSize) {
     }
   } else if (isAssumedShape && !isDeferred) {
     msg = "Assumed-shape array '%s' must be a dummy argument"_err_en_US;
   } else if (isAssumedSize && !isImplied) { // C833
     msg = "Assumed-size array '%s' must be a dummy argument"_err_en_US;
   } 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) {
       msg = "Named constant '%s' array must have constant or"
             " implied shape"_err_en_US;
     }
   } else if (!IsAllocatableOrPointer(symbol) && !isExplicit) {
     if (symbol.owner().IsDerivedType()) { // C749
if (!symbol.attrs().test(Attr::INTRINSIC) &&
       // There's no explicit constraint or "shall" that we can find in the
       // standard for this check, but it seems to be implied in multiple
       // sites, and ELEMENTAL non-intrinsic actual arguments *are*
       // explicitly forbidden.  But we allow "PROCEDURE(SIN)::dummy"
       // because it is explicitly legal to *pass* the specific intrinsic
       // 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()};
       messages_.Say(name,
           "Procedure component '%s' must have POINTER attribute"_err_en_US,
           name);
     }
     CheckPassArg(symbol, details.interface().symbol(), details);

flang/test/Semantics/resolve58.f90

subroutine s2(a, b, c)
   real :: h(10,*)  ! C833
   !ERROR: Assumed-rank array 'i' must be a dummy argument
   real :: i(..)  ! C837
 end
 
 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]
 end
 
 subroutine s4()
   type :: t
     integer, allocatable :: a(:)

 end
 
 subroutine s5()
   !ERROR: Allocatable array 'a' must have deferred shape or assumed rank
   integer :: a(10), b(:)
   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

flang/test/Semantics/separate-mp02.f90

 submodule(m2) sm2
 contains
   !ERROR: Module subprogram 's1' has 3 args but the corresponding interface body has 2
   module subroutine s1(x, y, z)
     real, intent(in) :: x
     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
     procedure(real) :: x
     !ERROR: Dummy argument 'y' is a data object; the corresponding argument in the interface body is not
     real :: y
   end
   !ERROR: Module subprogram 's4' has NON_RECURSIVE prefix but the corresponding interface body does not