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
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
//===-- lib/Semantics/check-data.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
//
//===----------------------------------------------------------------------===//
// DATA statement semantic analysis.
// - Applies static semantic checks to the variables in each data-stmt-set with
// class DataVarChecker;
// - Invokes conversion of DATA statement values to static initializers
#include "check-data.h"
#include "data-to-inits.h"
#include "flang/Evaluate/traverse.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Semantics/tools.h"
#include <algorithm>
#include <vector>
namespace Fortran::semantics {
// Ensures that references to an implied DO loop control variable are
// represented as such in the "body" of the implied DO loop.
void DataChecker::Enter(const parser::DataImpliedDo &x) {
auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
if (dynamicType->category() == TypeCategory::Integer) {
kind = dynamicType->kind();
}
}
exprAnalyzer_.AddImpliedDo(name.source, kind);
}
void DataChecker::Leave(const parser::DataImpliedDo &x) {
auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
exprAnalyzer_.RemoveImpliedDo(name.source);
}
// DataVarChecker applies static checks once to each variable that appears
// in a data-stmt-set. These checks are independent of the values that
// correspond to the variables.
class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
public:
using Base = evaluate::AllTraverse<DataVarChecker, true>;
DataVarChecker(SemanticsContext &c, parser::CharBlock src)
: Base{*this}, context_{c}, source_{src} {}
using Base::operator();
bool HasComponentWithoutSubscripts() const {
return hasComponent_ && !hasSubscript_;
}
bool operator()(const Symbol &symbol) { // C876
// 8.6.7p(2) - precludes non-pointers of derived types with
// default component values
const Scope &scope{context_.FindScope(source_)};
bool isFirstSymbol{isFirstSymbol_};
isFirstSymbol_ = false;
if (const char *whyNot{IsAutomatic(symbol) ? "Automatic variable"
: IsDummy(symbol) ? "Dummy argument"
: IsFunctionResult(symbol) ? "Function result"
: IsAllocatable(symbol) ? "Allocatable"
: IsInitialized(symbol, true) ? "Default-initialized"
: IsInBlankCommon(symbol) ? "Blank COMMON object"
: IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
// remaining checks don't apply to components
: !isFirstSymbol ? nullptr
: IsHostAssociated(symbol, scope) ? "Host-associated object"
: IsUseAssociated(symbol, scope) ? "USE-associated object"
: nullptr}) {
context_.Say(source_,
"%s '%s' must not be initialized in a DATA statement"_err_en_US,
whyNot, symbol.name());
return false;
} else if (IsProcedurePointer(symbol)) {
context_.Say(source_,
"Procedure pointer '%s' in a DATA statement is not standard"_en_US,
symbol.name());
}
return true;
}
bool operator()(const evaluate::Component &component) {
hasComponent_ = true;
const Symbol &lastSymbol{component.GetLastSymbol()};
if (isPointerAllowed_) {
if (IsPointer(lastSymbol) && hasSubscript_) { // C877
context_.Say(source_,
"Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
lastSymbol.name().ToString());
return false;
}
RestrictPointer();
} else {
if (IsPointer(lastSymbol)) { // C877
context_.Say(source_,
"Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
lastSymbol.name().ToString());
return false;
}
}
return (*this)(component.base()) && (*this)(lastSymbol);
}
bool operator()(const evaluate::ArrayRef &arrayRef) {
hasSubscript_ = true;
return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
}
bool operator()(const evaluate::Substring &substring) {
hasSubscript_ = true;
return (*this)(substring.parent()) && (*this)(substring.lower()) &&
(*this)(substring.upper());
}
bool operator()(const evaluate::CoarrayRef &) { // C874
context_.Say(
source_, "Data object must not be a coindexed variable"_err_en_US);
return false;
}
bool operator()(const evaluate::Subscript &subs) {
DataVarChecker subscriptChecker{context_, source_};
subscriptChecker.RestrictPointer();
return std::visit(
common::visitors{
[&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
return CheckSubscriptExpr(expr);
},
[&](const evaluate::Triplet &triplet) {
return CheckSubscriptExpr(triplet.lower()) &&
CheckSubscriptExpr(triplet.upper()) &&
CheckSubscriptExpr(triplet.stride());
},
},
subs.u) &&
subscriptChecker(subs.u);
}
template <typename T>
bool operator()(const evaluate::FunctionRef<T> &) const { // C875
context_.Say(source_,
"Data object variable must not be a function reference"_err_en_US);
return false;
}
void RestrictPointer() { isPointerAllowed_ = false; }
private:
bool CheckSubscriptExpr(
const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
return !x || CheckSubscriptExpr(*x);
}
bool CheckSubscriptExpr(
const evaluate::IndirectSubscriptIntegerExpr &expr) const {
return CheckSubscriptExpr(expr.value());
}
bool CheckSubscriptExpr(
const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
if (!evaluate::IsConstantExpr(expr)) { // C875,C881
context_.Say(
source_, "Data object must have constant subscripts"_err_en_US);
return false;
} else {
return true;
}
}
SemanticsContext &context_;
parser::CharBlock source_;
bool hasComponent_{false};
bool hasSubscript_{false};
bool isPointerAllowed_{true};
bool isFirstSymbol_{true};
};
void DataChecker::Leave(const parser::DataIDoObject &object) {
if (const auto *designator{
std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
&object.u)}) {
if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
auto source{designator->thing.value().source};
if (evaluate::IsConstantExpr(*expr)) { // C878,C879
exprAnalyzer_.context().Say(
source, "Data implied do object must be a variable"_err_en_US);
} else {
DataVarChecker checker{exprAnalyzer_.context(), source};
if (checker(*expr)) {
if (checker.HasComponentWithoutSubscripts()) { // C880
exprAnalyzer_.context().Say(source,
"Data implied do structure component must be subscripted"_err_en_US);
} else {
return;
}
}
}
}
currentSetHasFatalErrors_ = true;
}
}
void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
std::visit(common::visitors{
[](const parser::DataImpliedDo &) { // has own Enter()/Leave()
},
[&](const auto &var) {
auto expr{exprAnalyzer_.Analyze(var)};
if (!expr ||
!DataVarChecker{exprAnalyzer_.context(),
parser::FindSourceLocation(dataObject)}(*expr)) {
currentSetHasFatalErrors_ = true;
}
},
},
dataObject.u);
}
void DataChecker::Leave(const parser::DataStmtSet &set) {
if (!currentSetHasFatalErrors_) {
AccumulateDataInitializations(inits_, exprAnalyzer_, set);
}
currentSetHasFatalErrors_ = false;
}
void DataChecker::CompileDataInitializationsIntoInitializers() {
ConvertToInitializers(inits_, exprAnalyzer_);
}
} // namespace Fortran::semantics
|
GitWeb