1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
//===-- lib/Semantics/check-coarray.cpp -----------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#include "check-coarray.h"
#include "flang/Common/indirection.h"
#include "flang/Evaluate/expression.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Semantics/expression.h"
#include "flang/Semantics/tools.h"
namespace Fortran::semantics {
class CriticalBodyEnforce {
public:
CriticalBodyEnforce(
SemanticsContext &context, parser::CharBlock criticalSourcePosition)
: context_{context}, criticalSourcePosition_{criticalSourcePosition} {}
std::set<parser::Label> labels() { return labels_; }
template <typename T> bool Pre(const T &) { return true; }
template <typename T> void Post(const T &) {}
template <typename T> bool Pre(const parser::Statement<T> &statement) {
currentStatementSourcePosition_ = statement.source;
if (statement.label.has_value()) {
labels_.insert(*statement.label);
}
return true;
}
// C1118
void Post(const parser::ReturnStmt &) {
context_
.Say(currentStatementSourcePosition_,
"RETURN statement is not allowed in a CRITICAL construct"_err_en_US)
.Attach(criticalSourcePosition_, GetEnclosingMsg());
}
void Post(const parser::ExecutableConstruct &construct) {
if (IsImageControlStmt(construct)) {
context_
.Say(currentStatementSourcePosition_,
"An image control statement is not allowed in a CRITICAL"
" construct"_err_en_US)
.Attach(criticalSourcePosition_, GetEnclosingMsg());
}
}
private:
parser::MessageFixedText GetEnclosingMsg() {
return "Enclosing CRITICAL statement"_en_US;
}
SemanticsContext &context_;
std::set<parser::Label> labels_;
parser::CharBlock currentStatementSourcePosition_;
parser::CharBlock criticalSourcePosition_;
};
template <typename T>
static void CheckTeamType(SemanticsContext &context, const T &x) {
if (const auto *expr{GetExpr(x)}) {
if (!IsTeamType(evaluate::GetDerivedTypeSpec(expr->GetType()))) {
context.Say(parser::FindSourceLocation(x), // C1114
"Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
}
}
}
static void CheckTeamStat(
SemanticsContext &context, const parser::ImageSelectorSpec::Stat &stat) {
const parser::Variable &var{stat.v.thing.thing.value()};
if (parser::GetCoindexedNamedObject(var)) {
context.Say(parser::FindSourceLocation(var), // C931
"Image selector STAT variable must not be a coindexed "
"object"_err_en_US);
}
}
void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) {
CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t));
CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
}
void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) {
CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
}
void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) {
haveStat_ = false;
haveTeam_ = false;
haveTeamNumber_ = false;
for (const auto &imageSelectorSpec :
std::get<std::list<parser::ImageSelectorSpec>>(imageSelector.t)) {
if (const auto *team{
std::get_if<parser::TeamValue>(&imageSelectorSpec.u)}) {
if (haveTeam_) {
context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
"TEAM value can only be specified once"_err_en_US);
}
CheckTeamType(context_, *team);
haveTeam_ = true;
}
if (const auto *stat{std::get_if<parser::ImageSelectorSpec::Stat>(
&imageSelectorSpec.u)}) {
if (haveStat_) {
context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
"STAT variable can only be specified once"_err_en_US);
}
CheckTeamStat(context_, *stat);
haveStat_ = true;
}
if (std::get_if<parser::ImageSelectorSpec::Team_Number>(
&imageSelectorSpec.u)) {
if (haveTeamNumber_) {
context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
"TEAM_NUMBER value can only be specified once"_err_en_US);
}
haveTeamNumber_ = true;
}
}
if (haveTeam_ && haveTeamNumber_) {
context_.Say(parser::FindSourceLocation(imageSelector), // C930
"Cannot specify both TEAM and TEAM_NUMBER"_err_en_US);
}
}
void CoarrayChecker::Leave(const parser::FormTeamStmt &x) {
CheckTeamType(context_, std::get<parser::TeamVariable>(x.t));
}
void CoarrayChecker::Enter(const parser::CriticalConstruct &x) {
auto &criticalStmt{std::get<parser::Statement<parser::CriticalStmt>>(x.t)};
const parser::Block &block{std::get<parser::Block>(x.t)};
CriticalBodyEnforce criticalBodyEnforce{context_, criticalStmt.source};
parser::Walk(block, criticalBodyEnforce);
// C1119
LabelEnforce criticalLabelEnforce{
context_, criticalBodyEnforce.labels(), criticalStmt.source, "CRITICAL"};
parser::Walk(block, criticalLabelEnforce);
}
// Check that coarray names and selector names are all distinct.
void CoarrayChecker::CheckNamesAreDistinct(
const std::list<parser::CoarrayAssociation> &list) {
std::set<parser::CharBlock> names;
auto getPreviousUse{
[&](const parser::Name &name) -> const parser::CharBlock * {
auto pair{names.insert(name.source)};
return !pair.second ? &*pair.first : nullptr;
}};
for (const auto &assoc : list) {
const auto &decl{std::get<parser::CodimensionDecl>(assoc.t)};
const auto &selector{std::get<parser::Selector>(assoc.t)};
const auto &declName{std::get<parser::Name>(decl.t)};
if (context_.HasError(declName)) {
continue; // already reported an error about this name
}
if (auto *prev{getPreviousUse(declName)}) {
Say2(declName.source, // C1113
"Coarray '%s' was already used as a selector or coarray in this statement"_err_en_US,
*prev, "Previous use of '%s'"_en_US);
}
// ResolveNames verified the selector is a simple name
const parser::Name *name{parser::Unwrap<parser::Name>(selector)};
if (name) {
if (auto *prev{getPreviousUse(*name)}) {
Say2(name->source, // C1113, C1115
"Selector '%s' was already used as a selector or coarray in this statement"_err_en_US,
*prev, "Previous use of '%s'"_en_US);
}
}
}
}
void CoarrayChecker::Say2(const parser::CharBlock &name1,
parser::MessageFixedText &&msg1, const parser::CharBlock &name2,
parser::MessageFixedText &&msg2) {
context_.Say(name1, std::move(msg1), name1)
.Attach(name2, std::move(msg2), name2);
}
} // namespace Fortran::semantics
|
