diff options
author | Peter Klausler <35819229+klausler@users.noreply.github.com> | 2024-05-01 12:25:31 -0700 |
---|---|---|
committer | GitHub <noreply@github.com> | 2024-05-01 12:25:31 -0700 |
commit | 465807eedcbf571d43d38e7534f38cffd5f83bec (patch) | |
tree | c1ebffe7e1e6430b8ce1c7a5242b249beb3b7824 | |
parent | 71113047298ccb92e6c636a535f0f855a04ee0db (diff) |
[flang] Catch missing "not a dummy argument" cases (#90268)
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.
-rw-r--r-- | flang/lib/Semantics/check-declarations.cpp | 37 | ||||
-rw-r--r-- | flang/test/Semantics/call14.f90 | 2 | ||||
-rw-r--r-- | flang/test/Semantics/resolve58.f90 | 8 |
3 files changed, 16 insertions, 31 deletions
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index d49c8e059591..63665c224e2b 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); @@ -1214,9 +1208,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); } @@ -1240,14 +1233,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 042243b56059..e586d4eebd25 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 447e14ae80a9..2e42eb157f5b 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 |