[flang-commits] [flang] [flang] Catch missing "not a dummy argument" cases (PR #90268)
via flang-commits
flang-commits at lists.llvm.org
Fri Apr 26 13:55:04 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
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
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
``````````
</details>
https://github.com/llvm/llvm-project/pull/90268
More information about the flang-commits
mailing list