Skip to content

Commit be2135b

Browse files
akuhlensakuhlens
committed
address feedback
1 parent f86d026 commit be2135b

File tree

3 files changed

+87
-66
lines changed

3 files changed

+87
-66
lines changed

‎flang/lib/Semantics/check-allocate.cpp‎

Lines changed: 15 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -26,8 +26,10 @@ struct AllocateCheckerInfo {
2626
std::optional<evaluate::DynamicType> sourceExprType;
2727
std::optional<parser::CharBlock> sourceExprLoc;
2828
std::optional<parser::CharBlock> typeSpecLoc;
29-
const parser::Name *statVar{nullptr};
30-
const parser::Name *msgVar{nullptr};
29+
std::optional<parser::CharBlock> statSource;
30+
std::optional<parser::CharBlock> msgSource;
31+
const SomeExpr *statVar{nullptr};
32+
const SomeExpr *msgVar{nullptr};
3133
int sourceExprRank{0}; // only valid if gotMold || gotSource
3234
bool gotStat{false};
3335
bool gotMsg{false};
@@ -148,11 +150,10 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
148150
context.Say(
149151
"STAT may not be duplicated in a ALLOCATE statement"_err_en_US);
150152
}
151-
if (const auto *designator{
152-
parser::Unwrap<parser::Designator>(var)}) {
153-
info.statVar = &parser::GetLastName(*designator);
154-
}
155153
info.gotStat = true;
154+
info.statVar = GetExpr(context, var);
155+
info.statSource =
156+
parser::Unwrap<parser::Variable>(var)->GetSource();
156157
},
157158
[&](const parser::MsgVariable &var) {
158159
WarnOnDeferredLengthCharacterScalar(context,
@@ -164,11 +165,10 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
164165
context.Say(
165166
"ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US);
166167
}
167-
if (const auto *designator{
168-
parser::Unwrap<parser::Designator>(var)}) {
169-
info.msgVar = &parser::GetLastName(*designator);
170-
}
171168
info.gotMsg = true;
169+
info.msgVar = GetExpr(context, var);
170+
info.msgSource =
171+
parser::Unwrap<parser::Variable>(var)->GetSource();
172172
},
173173
},
174174
statOrErr.u);
@@ -700,17 +700,13 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
700700
"Object in ALLOCATE must have DEVICE attribute when STREAM option is specified"_err_en_US);
701701
}
702702
}
703-
if (allocateInfo_.gotStat && allocateInfo_.statVar) {
704-
if (const Symbol *symbol{allocateInfo_.statVar->symbol};
705-
symbol && *ultimate_ == symbol->GetUltimate()) {
706-
context.Say(allocateInfo_.statVar->source,
703+
if (const SomeExpr *allocObj{GetExpr(context, allocateObject_)}) {
704+
if (allocateInfo_.statVar && *allocObj == *allocateInfo_.statVar) {
705+
context.Say(allocateInfo_.statSource.value_or(name_.source),
707706
"STAT variable in ALLOCATE must not be the variable being allocated"_err_en_US);
708707
}
709-
}
710-
if (allocateInfo_.gotMsg && allocateInfo_.msgVar) {
711-
if (const Symbol *symbol{allocateInfo_.msgVar->symbol};
712-
symbol && *ultimate_ == symbol->GetUltimate()) {
713-
context.Say(allocateInfo_.msgVar->source,
708+
if (allocateInfo_.msgVar && *allocObj == *allocateInfo_.msgVar) {
709+
context.Say(allocateInfo_.msgSource.value_or(name_.source),
714710
"ERRMSG variable in ALLOCATE must not be the variable being allocated"_err_en_US);
715711
}
716712
}

‎flang/lib/Semantics/check-deallocate.cpp‎

Lines changed: 41 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -13,12 +13,15 @@
1313
#include "flang/Parser/parse-tree.h"
1414
#include "flang/Semantics/expression.h"
1515
#include "flang/Semantics/tools.h"
16+
#include <optional>
1617

1718
namespace Fortran::semantics {
1819

1920
void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
2021
bool gotStat{false}, gotMsg{false};
21-
const parser::Name *statVar{nullptr}, *msgVar{nullptr};
22+
const SomeExpr *statVar{nullptr}, *msgVar{nullptr};
23+
std::optional<parser::CharBlock> statSource;
24+
std::optional<parser::CharBlock> msgSource;
2225
for (const parser::StatOrErrmsg &deallocOpt :
2326
std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
2427
common::visit(
@@ -28,11 +31,9 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
2831
context_.Say(
2932
"STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
3033
}
31-
if (const auto *designator{
32-
parser::Unwrap<parser::Designator>(var)}) {
33-
statVar = &parser::GetLastName(*designator);
34-
}
3534
gotStat = true;
35+
statVar = GetExpr(context_, var);
36+
statSource = parser::Unwrap<parser::Variable>(var)->GetSource();
3637
},
3738
[&](const parser::MsgVariable &var) {
3839
WarnOnDeferredLengthCharacterScalar(context_,
@@ -43,51 +44,49 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
4344
context_.Say(
4445
"ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
4546
}
46-
if (const auto *designator{
47-
parser::Unwrap<parser::Designator>(var)}) {
48-
msgVar = &parser::GetLastName(*designator);
49-
}
5047
gotMsg = true;
48+
msgVar = GetExpr(context_, var);
49+
msgSource = parser::Unwrap<parser::Variable>(var)->GetSource();
5150
},
5251
},
5352
deallocOpt.u);
5453
}
5554
for (const parser::AllocateObject &allocateObject :
5655
std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)) {
57-
const Symbol *ultimate{nullptr};
56+
parser::CharBlock source;
5857
common::visit(
5958
common::visitors{
6059
[&](const parser::Name &name) {
61-
if (name.symbol) {
62-
ultimate = &name.symbol->GetUltimate();
63-
}
64-
if (context_.HasError(ultimate)) {
60+
const Symbol *symbol{
61+
name.symbol ? &name.symbol->GetUltimate() : nullptr};
62+
source = name.source;
63+
if (context_.HasError(symbol)) {
6564
// already reported an error
66-
} else if (!IsVariableName(*ultimate)) {
67-
context_.Say(name.source,
65+
} else if (!IsVariableName(*symbol)) {
66+
context_.Say(source,
6867
"Name in DEALLOCATE statement must be a variable name"_err_en_US);
69-
} else if (!IsAllocatableOrObjectPointer(ultimate)) { // C936
70-
context_.Say(name.source,
68+
} else if (!IsAllocatableOrObjectPointer(symbol)) { // C936
69+
context_.Say(source,
7170
"Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
72-
} else if (auto whyNot{WhyNotDefinable(name.source,
73-
context_.FindScope(name.source),
74-
{DefinabilityFlag::PointerDefinition,
75-
DefinabilityFlag::AcceptAllocatable,
76-
DefinabilityFlag::PotentialDeallocation},
77-
*ultimate)}) {
71+
} else if (auto whyNot{
72+
WhyNotDefinable(source, context_.FindScope(source),
73+
{DefinabilityFlag::PointerDefinition,
74+
DefinabilityFlag::AcceptAllocatable,
75+
DefinabilityFlag::PotentialDeallocation},
76+
*symbol)}) {
7877
// Catch problems with non-definability of the
7978
// pointer/allocatable
8079
context_
81-
.Say(name.source,
80+
.Say(source,
8281
"Name in DEALLOCATE statement is not definable"_err_en_US)
8382
.Attach(std::move(
8483
whyNot->set_severity(parser::Severity::Because)));
85-
} else if (auto whyNot{WhyNotDefinable(name.source,
86-
context_.FindScope(name.source),
87-
DefinabilityFlags{}, *ultimate)}) {
84+
} else if (auto whyNot{
85+
WhyNotDefinable(source, context_.FindScope(source),
86+
DefinabilityFlags{}, *symbol)}) {
8887
// Catch problems with non-definability of the dynamic object
8988
context_
90-
.Say(name.source,
89+
.Say(source,
9190
"Object in DEALLOCATE statement is not deallocatable"_err_en_US)
9291
.Attach(std::move(
9392
whyNot->set_severity(parser::Severity::Because)));
@@ -98,12 +97,13 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
9897
[&](const parser::StructureComponent &structureComponent) {
9998
// Only perform structureComponent checks if it was successfully
10099
// analyzed by expression analysis.
101-
auto source{structureComponent.component.source};
102-
if (structureComponent.component.symbol) {
103-
ultimate = &structureComponent.component.symbol->GetUltimate();
104-
}
100+
source = structureComponent.component.source;
105101
if (const auto *expr{GetExpr(context_, allocateObject)}) {
106-
if (!IsAllocatableOrObjectPointer(ultimate)) { // F'2023 C936
102+
if (const Symbol *symbol{structureComponent.component.symbol
103+
? &structureComponent.component.symbol
104+
->GetUltimate()
105+
: nullptr};
106+
!IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
107107
context_.Say(source,
108108
"Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
109109
} else if (auto whyNot{WhyNotDefinable(source,
@@ -133,20 +133,14 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
133133
},
134134
},
135135
allocateObject.u);
136-
if (ultimate) {
137-
if (gotStat && statVar) {
138-
if (const Symbol *symbol{statVar->symbol};
139-
symbol && *ultimate == symbol->GetUltimate()) {
140-
context_.Say(statVar->source,
141-
"STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US);
142-
}
136+
if (const SomeExpr *allocObj{GetExpr(context_, allocateObject)}) {
137+
if (statVar && *allocObj == *statVar) {
138+
context_.Say(statSource.value_or(source),
139+
"STAT variable in DEALLOCATE must not be the variable being deallocated"_err_en_US);
143140
}
144-
if (gotMsg && msgVar) {
145-
if (const Symbol *symbol{msgVar->symbol};
146-
symbol && *ultimate == symbol->GetUltimate()) {
147-
context_.Say(msgVar->source,
148-
"ERRMSG variable in DEALLOCATE must not be the variable being deallocated"_err_en_US);
149-
}
141+
if (msgVar && *allocObj == *msgVar) {
142+
context_.Say(msgSource.value_or(source),
143+
"ERRMSG variable in DEALLOCATE must not be the variable being deallocated"_err_en_US);
150144
}
151145
}
152146
}

‎flang/test/Semantics/allocate14.f90‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,15 @@
22
! Check for semantic errors in ALLOCATE statements
33

44
program allocate14
5+
56
integer, allocatable :: i1, i2
67
character(200), allocatable :: msg1, msg2
8+
type t
9+
integer, allocatable :: i
10+
character(10), allocatable :: msg
11+
end type t
12+
type(t) :: tt(2)
13+
type(t), allocatable :: ts(:)
714

815
allocate(i1)
916
allocate(msg1)
@@ -21,5 +28,29 @@ program allocate14
2128
deallocate(i2, stat=i2, errmsg=msg2)
2229
!ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
2330
deallocate(msg2, stat=i2, errmsg=msg2)
31+
32+
allocate(tt(1)%i)
33+
allocate(tt(1)%msg)
34+
35+
allocate(tt(2)%i, stat=tt(1)%i, errmsg=tt(1)%msg)
36+
allocate(tt(2)%msg, stat=tt(1)%i, errmsg=tt(1)%msg)
37+
deallocate(tt(2)%i, stat=tt(1)%i, errmsg=tt(1)%msg)
38+
deallocate(tt(2)%msg, stat=tt(1)%i, errmsg=tt(1)%msg)
39+
40+
!ERROR: STAT variable in ALLOCATE must not be the variable being allocated
41+
allocate(tt(2)%i, stat=tt(2)%i, errmsg=tt(2)%msg)
42+
!ERROR: ERRMSG variable in ALLOCATE must not be the variable being allocated
43+
allocate(tt(2)%msg, stat=tt(2)%i, errmsg=tt(2)%msg)
44+
!ERROR: STAT variable in DEALLOCATE must not be the variable being deallocated
45+
deallocate(tt(2)%i, stat=tt(2)%i, errmsg=tt(2)%msg)
46+
!ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
47+
deallocate(tt(2)%msg, stat=tt(2)%i, errmsg=tt(2)%msg)
48+
49+
!FIXME: STAT variable in ALLOCATE must not be the variable being allocated
50+
!FIXME: ERRMSG variable in ALLOCATE must not be the variable being allocated
51+
allocate(ts(10), stat=ts(1)%i, errmsg=ts(1)%msg)
52+
!FIXME: STAT variable in DEALLOCATE must not be the variable being deallocated
53+
!FIXME: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
54+
deallocate(ts, stat=ts(1)%i, errmsg=ts(1)%msg)
2455
end program
2556

0 commit comments

Comments
 (0)