[flang] Catch missing "not a dummy argument" cases

[klausler]

Declaration checking is looking for inappropriate usage of the INTENT, VALUE, & OPTIONAL attributes in multiple places, and some oddball cases like ENTRY points are not checked. Centralize the check for attributes that apply only to dummy arguments into one spot.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Declaration checking is looking for inappropriate usage of the INTENT, VALUE, & OPTIONAL attributes in multiple places, and some oddball cases like ENTRY points are not checked. Centralize the check for attributes that apply only to dummy arguments into one spot.

---

Full diff: https://github.com/llvm/llvm-project/pull/90268.diff

3 Files Affected:

• (modified) flang/lib/Semantics/check-declarations.cpp (+11-26)
• (modified) flang/test/Semantics/call14.f90 (+1-1)
• (modified) flang/test/Semantics/resolve58.f90 (+4-4)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 901ac20f8aae9b..6fa86b18e388e9 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -289,6 +289,14 @@ void CheckHelper::Check(const Symbol &symbol) {
     messages_.Say(
         "An entity may not have the ASYNCHRONOUS attribute unless it is a variable"_err_en_US);
   }
+  if (symbol.attrs().HasAny({Attr::INTENT_IN, Attr::INTENT_INOUT,
+          Attr::INTENT_OUT, Attr::OPTIONAL, Attr::VALUE}) &&
+      !IsDummy(symbol)) {
+    messages_.Say(
+        "Only a dummy argument may have an INTENT, VALUE, or OPTIONAL attribute"_err_en_US);
+  } else if (symbol.attrs().test(Attr::VALUE)) {
+    CheckValue(symbol, derived);
+  }
 
   if (isDone) {
     return; // following checks do not apply
@@ -411,9 +419,6 @@ void CheckHelper::Check(const Symbol &symbol) {
       // The non-dummy case is a hard error that's caught elsewhere.
     }
   }
-  if (symbol.attrs().test(Attr::VALUE)) {
-    CheckValue(symbol, derived);
-  }
   if (IsDummy(symbol)) {
     if (IsNamedConstant(symbol)) {
       messages_.Say(
@@ -527,13 +532,10 @@ void CheckHelper::CheckBindCFunctionResult(const Symbol &symbol) { // C1553
 
 void CheckHelper::CheckValue(
     const Symbol &symbol, const DerivedTypeSpec *derived) { // C863 - C865
-  if (!IsDummy(symbol)) {
-    messages_.Say(
-        "VALUE attribute may apply only to a dummy argument"_err_en_US);
-  }
   if (IsProcedure(symbol)) {
     messages_.Say(
         "VALUE attribute may apply only to a dummy data object"_err_en_US);
+    return; // don't pile on
   }
   if (IsAssumedSizeArray(symbol)) {
     messages_.Say(
@@ -786,14 +788,6 @@ void CheckHelper::CheckObjectEntity(
         }
       }
     }
-  } 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 (!details.ignoreTKR().empty()) {
     messages_.Say(
         "!DIR$ IGNORE_TKR directive may apply only to a dummy data argument"_err_en_US);
@@ -1211,9 +1205,8 @@ void CheckHelper::CheckProcEntity(
   const Symbol *interface{details.procInterface()};
   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))) {
+        symbol.attrs().HasAny(
+            {Attr::INTENT_IN, Attr::INTENT_OUT, Attr::INTENT_INOUT})) {
       messages_.Say("A dummy procedure without the POINTER attribute"
                     " may not have an INTENT attribute"_err_en_US);
     }
@@ -1237,14 +1230,6 @@ void CheckHelper::CheckProcEntity(
         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 (IsPointer(symbol)) {
     CheckPointerInitialization(symbol);
     if (interface) {
diff --git a/flang/test/Semantics/call14.f90 b/flang/test/Semantics/call14.f90
index 042243b5605938..e586d4eebd2535 100644
--- a/flang/test/Semantics/call14.f90
+++ b/flang/test/Semantics/call14.f90
@@ -9,7 +9,7 @@ module m
   !ERROR: VALUE attribute may apply only to a dummy data object
   subroutine C863(notData,assumedSize,coarray,coarrayComponent,assumedRank,assumedLen)
     external :: notData
-    !ERROR: VALUE attribute may apply only to a dummy argument
+    !ERROR: Only a dummy argument may have an INTENT, VALUE, or OPTIONAL attribute
     real, value :: notADummy
     value :: notData
     !ERROR: VALUE attribute may not apply to an assumed-size array
diff --git a/flang/test/Semantics/resolve58.f90 b/flang/test/Semantics/resolve58.f90
index 447e14ae80a975..2e42eb157f5b50 100644
--- a/flang/test/Semantics/resolve58.f90
+++ b/flang/test/Semantics/resolve58.f90
@@ -69,12 +69,12 @@ subroutine s6()
 
   !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
+  !ERROR: Only a dummy argument may have an INTENT, VALUE, or OPTIONAL attribute
   real, intent(in) :: local2
-  !ERROR: INTENT attributes may apply only to a dummy argument
+  !ERROR: Only a dummy argument may have an INTENT, VALUE, or OPTIONAL attribute
   procedure(), intent(in) :: p1
-  !ERROR: OPTIONAL attribute may apply only to a dummy argument
+  !ERROR: Only a dummy argument may have an INTENT, VALUE, or OPTIONAL attribute
   real, optional :: local3
-  !ERROR: OPTIONAL attribute may apply only to a dummy argument
+  !ERROR: Only a dummy argument may have an INTENT, VALUE, or OPTIONAL attribute
   procedure(), optional :: p2
 end subroutine

[clementval]

LGTM