Skip to content

Commit f86d026

Browse files
akuhlensakuhlens
committed
initial commit
1 parent 916e8f7 commit f86d026

File tree

3 files changed

+114
-41
lines changed

3 files changed

+114
-41
lines changed

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

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,8 @@ 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};
2931
int sourceExprRank{0}; // only valid if gotMold || gotSource
3032
bool gotStat{false};
3133
bool gotMsg{false};
@@ -141,11 +143,15 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
141143
[&](const parser::StatOrErrmsg &statOrErr) {
142144
common::visit(
143145
common::visitors{
144-
[&](const parser::StatVariable &) {
146+
[&](const parser::StatVariable &var) {
145147
if (info.gotStat) { // C943
146148
context.Say(
147149
"STAT may not be duplicated in a ALLOCATE statement"_err_en_US);
148150
}
151+
if (const auto *designator{
152+
parser::Unwrap<parser::Designator>(var)}) {
153+
info.statVar = &parser::GetLastName(*designator);
154+
}
149155
info.gotStat = true;
150156
},
151157
[&](const parser::MsgVariable &var) {
@@ -158,6 +164,10 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
158164
context.Say(
159165
"ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US);
160166
}
167+
if (const auto *designator{
168+
parser::Unwrap<parser::Designator>(var)}) {
169+
info.msgVar = &parser::GetLastName(*designator);
170+
}
161171
info.gotMsg = true;
162172
},
163173
},
@@ -690,6 +700,20 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
690700
"Object in ALLOCATE must have DEVICE attribute when STREAM option is specified"_err_en_US);
691701
}
692702
}
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,
707+
"STAT variable in ALLOCATE must not be the variable being allocated"_err_en_US);
708+
}
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,
714+
"ERRMSG variable in ALLOCATE must not be the variable being allocated"_err_en_US);
715+
}
716+
}
693717
return RunCoarrayRelatedChecks(context);
694718
}
695719

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

Lines changed: 64 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -17,28 +17,64 @@
1717
namespace Fortran::semantics {
1818

1919
void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
20+
bool gotStat{false}, gotMsg{false};
21+
const parser::Name *statVar{nullptr}, *msgVar{nullptr};
22+
for (const parser::StatOrErrmsg &deallocOpt :
23+
std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
24+
common::visit(
25+
common::visitors{
26+
[&](const parser::StatVariable &var) {
27+
if (gotStat) {
28+
context_.Say(
29+
"STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
30+
}
31+
if (const auto *designator{
32+
parser::Unwrap<parser::Designator>(var)}) {
33+
statVar = &parser::GetLastName(*designator);
34+
}
35+
gotStat = true;
36+
},
37+
[&](const parser::MsgVariable &var) {
38+
WarnOnDeferredLengthCharacterScalar(context_,
39+
GetExpr(context_, var),
40+
parser::UnwrapRef<parser::Variable>(var).GetSource(),
41+
"ERRMSG=");
42+
if (gotMsg) {
43+
context_.Say(
44+
"ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
45+
}
46+
if (const auto *designator{
47+
parser::Unwrap<parser::Designator>(var)}) {
48+
msgVar = &parser::GetLastName(*designator);
49+
}
50+
gotMsg = true;
51+
},
52+
},
53+
deallocOpt.u);
54+
}
2055
for (const parser::AllocateObject &allocateObject :
2156
std::get<std::list<parser::AllocateObject>>(deallocateStmt.t)) {
57+
const Symbol *ultimate{nullptr};
2258
common::visit(
2359
common::visitors{
2460
[&](const parser::Name &name) {
25-
const Symbol *symbol{
26-
name.symbol ? &name.symbol->GetUltimate() : nullptr};
27-
;
28-
if (context_.HasError(symbol)) {
61+
if (name.symbol) {
62+
ultimate = &name.symbol->GetUltimate();
63+
}
64+
if (context_.HasError(ultimate)) {
2965
// already reported an error
30-
} else if (!IsVariableName(*symbol)) {
66+
} else if (!IsVariableName(*ultimate)) {
3167
context_.Say(name.source,
3268
"Name in DEALLOCATE statement must be a variable name"_err_en_US);
33-
} else if (!IsAllocatableOrObjectPointer(symbol)) { // C936
69+
} else if (!IsAllocatableOrObjectPointer(ultimate)) { // C936
3470
context_.Say(name.source,
3571
"Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
3672
} else if (auto whyNot{WhyNotDefinable(name.source,
3773
context_.FindScope(name.source),
3874
{DefinabilityFlag::PointerDefinition,
3975
DefinabilityFlag::AcceptAllocatable,
4076
DefinabilityFlag::PotentialDeallocation},
41-
*symbol)}) {
77+
*ultimate)}) {
4278
// Catch problems with non-definability of the
4379
// pointer/allocatable
4480
context_
@@ -48,7 +84,7 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
4884
whyNot->set_severity(parser::Severity::Because)));
4985
} else if (auto whyNot{WhyNotDefinable(name.source,
5086
context_.FindScope(name.source),
51-
DefinabilityFlags{}, *symbol)}) {
87+
DefinabilityFlags{}, *ultimate)}) {
5288
// Catch problems with non-definability of the dynamic object
5389
context_
5490
.Say(name.source,
@@ -63,13 +99,11 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
6399
// Only perform structureComponent checks if it was successfully
64100
// analyzed by expression analysis.
65101
auto source{structureComponent.component.source};
102+
if (structureComponent.component.symbol) {
103+
ultimate = &structureComponent.component.symbol->GetUltimate();
104+
}
66105
if (const auto *expr{GetExpr(context_, allocateObject)}) {
67-
if (const Symbol *
68-
symbol{structureComponent.component.symbol
69-
? &structureComponent.component.symbol
70-
->GetUltimate()
71-
: nullptr};
72-
!IsAllocatableOrObjectPointer(symbol)) { // F'2023 C936
106+
if (!IsAllocatableOrObjectPointer(ultimate)) { // F'2023 C936
73107
context_.Say(source,
74108
"Component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
75109
} else if (auto whyNot{WhyNotDefinable(source,
@@ -99,32 +133,22 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
99133
},
100134
},
101135
allocateObject.u);
102-
}
103-
bool gotStat{false}, gotMsg{false};
104-
for (const parser::StatOrErrmsg &deallocOpt :
105-
std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
106-
common::visit(
107-
common::visitors{
108-
[&](const parser::StatVariable &) {
109-
if (gotStat) {
110-
context_.Say(
111-
"STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
112-
}
113-
gotStat = true;
114-
},
115-
[&](const parser::MsgVariable &var) {
116-
WarnOnDeferredLengthCharacterScalar(context_,
117-
GetExpr(context_, var),
118-
parser::UnwrapRef<parser::Variable>(var).GetSource(),
119-
"ERRMSG=");
120-
if (gotMsg) {
121-
context_.Say(
122-
"ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
123-
}
124-
gotMsg = true;
125-
},
126-
},
127-
deallocOpt.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+
}
143+
}
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+
}
150+
}
151+
}
128152
}
129153
}
130154

‎flang/test/Semantics/allocate14.f90‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1
2+
! Check for semantic errors in ALLOCATE statements
3+
4+
program allocate14
5+
integer, allocatable :: i1, i2
6+
character(200), allocatable :: msg1, msg2
7+
8+
allocate(i1)
9+
allocate(msg1)
10+
11+
allocate(i2, stat=i1, errmsg=msg1)
12+
allocate(msg2, stat=i1, errmsg=msg1)
13+
deallocate(i2, stat=i1, errmsg=msg1)
14+
deallocate(msg2, stat=i1, errmsg=msg1)
15+
16+
!ERROR: STAT variable in ALLOCATE must not be the variable being allocated
17+
allocate(i2, stat=i2, errmsg=msg2)
18+
!ERROR: ERRMSG variable in ALLOCATE must not be the variable being allocated
19+
allocate(msg2, stat=i2, errmsg=msg2)
20+
!ERROR: STAT variable in DEALLOCATE must not be the variable being deallocated
21+
deallocate(i2, stat=i2, errmsg=msg2)
22+
!ERROR: ERRMSG variable in DEALLOCATE must not be the variable being deallocated
23+
deallocate(msg2, stat=i2, errmsg=msg2)
24+
end program
25+

0 commit comments

Comments
 (0)