|
173
|
1 //===-- lib/Semantics/check-data.cpp --------------------------------------===//
|
|
|
2 //
|
|
|
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
|
4 // See https://llvm.org/LICENSE.txt for license information.
|
|
|
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
|
6 //
|
|
|
7 //===----------------------------------------------------------------------===//
|
|
|
8
|
|
207
|
9 // DATA statement semantic analysis.
|
|
|
10 // - Applies static semantic checks to the variables in each data-stmt-set with
|
|
|
11 // class DataVarChecker;
|
|
|
12 // - Invokes conversion of DATA statement values to static initializers
|
|
|
13
|
|
173
|
14 #include "check-data.h"
|
|
207
|
15 #include "data-to-inits.h"
|
|
173
|
16 #include "flang/Evaluate/traverse.h"
|
|
207
|
17 #include "flang/Parser/parse-tree.h"
|
|
|
18 #include "flang/Parser/tools.h"
|
|
|
19 #include "flang/Semantics/tools.h"
|
|
|
20 #include <algorithm>
|
|
|
21 #include <vector>
|
|
173
|
22
|
|
|
23 namespace Fortran::semantics {
|
|
|
24
|
|
|
25 // Ensures that references to an implied DO loop control variable are
|
|
|
26 // represented as such in the "body" of the implied DO loop.
|
|
|
27 void DataChecker::Enter(const parser::DataImpliedDo &x) {
|
|
|
28 auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
|
|
|
29 int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
|
|
|
30 if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
|
|
207
|
31 if (dynamicType->category() == TypeCategory::Integer) {
|
|
|
32 kind = dynamicType->kind();
|
|
|
33 }
|
|
173
|
34 }
|
|
|
35 exprAnalyzer_.AddImpliedDo(name.source, kind);
|
|
|
36 }
|
|
|
37
|
|
|
38 void DataChecker::Leave(const parser::DataImpliedDo &x) {
|
|
|
39 auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
|
|
|
40 exprAnalyzer_.RemoveImpliedDo(name.source);
|
|
|
41 }
|
|
|
42
|
|
207
|
43 // DataVarChecker applies static checks once to each variable that appears
|
|
|
44 // in a data-stmt-set. These checks are independent of the values that
|
|
|
45 // correspond to the variables.
|
|
173
|
46 class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
|
|
|
47 public:
|
|
|
48 using Base = evaluate::AllTraverse<DataVarChecker, true>;
|
|
|
49 DataVarChecker(SemanticsContext &c, parser::CharBlock src)
|
|
|
50 : Base{*this}, context_{c}, source_{src} {}
|
|
|
51 using Base::operator();
|
|
|
52 bool HasComponentWithoutSubscripts() const {
|
|
|
53 return hasComponent_ && !hasSubscript_;
|
|
|
54 }
|
|
207
|
55 bool operator()(const Symbol &symbol) { // C876
|
|
|
56 // 8.6.7p(2) - precludes non-pointers of derived types with
|
|
|
57 // default component values
|
|
|
58 const Scope &scope{context_.FindScope(source_)};
|
|
|
59 bool isFirstSymbol{isFirstSymbol_};
|
|
|
60 isFirstSymbol_ = false;
|
|
|
61 if (const char *whyNot{IsAutomatic(symbol) ? "Automatic variable"
|
|
|
62 : IsDummy(symbol) ? "Dummy argument"
|
|
|
63 : IsFunctionResult(symbol) ? "Function result"
|
|
|
64 : IsAllocatable(symbol) ? "Allocatable"
|
|
|
65 : IsInitialized(symbol, true) ? "Default-initialized"
|
|
|
66 : IsInBlankCommon(symbol) ? "Blank COMMON object"
|
|
|
67 : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
|
|
|
68 // remaining checks don't apply to components
|
|
|
69 : !isFirstSymbol ? nullptr
|
|
|
70 : IsHostAssociated(symbol, scope) ? "Host-associated object"
|
|
|
71 : IsUseAssociated(symbol, scope) ? "USE-associated object"
|
|
|
72 : symbol.has<AssocEntityDetails>() ? "Construct association"
|
|
|
73 : nullptr}) {
|
|
|
74 context_.Say(source_,
|
|
|
75 "%s '%s' must not be initialized in a DATA statement"_err_en_US,
|
|
|
76 whyNot, symbol.name());
|
|
|
77 return false;
|
|
|
78 } else if (IsProcedurePointer(symbol)) {
|
|
|
79 context_.Say(source_,
|
|
|
80 "Procedure pointer '%s' in a DATA statement is not standard"_en_US,
|
|
|
81 symbol.name());
|
|
|
82 }
|
|
|
83 return true;
|
|
|
84 }
|
|
173
|
85 bool operator()(const evaluate::Component &component) {
|
|
|
86 hasComponent_ = true;
|
|
207
|
87 const Symbol &lastSymbol{component.GetLastSymbol()};
|
|
|
88 if (isPointerAllowed_) {
|
|
|
89 if (IsPointer(lastSymbol) && hasSubscript_) { // C877
|
|
|
90 context_.Say(source_,
|
|
|
91 "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
|
|
|
92 lastSymbol.name().ToString());
|
|
|
93 return false;
|
|
|
94 }
|
|
|
95 RestrictPointer();
|
|
|
96 } else {
|
|
|
97 if (IsPointer(lastSymbol)) { // C877
|
|
|
98 context_.Say(source_,
|
|
|
99 "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
|
|
|
100 lastSymbol.name().ToString());
|
|
|
101 return false;
|
|
|
102 }
|
|
|
103 }
|
|
|
104 return (*this)(component.base()) && (*this)(lastSymbol);
|
|
|
105 }
|
|
|
106 bool operator()(const evaluate::ArrayRef &arrayRef) {
|
|
|
107 hasSubscript_ = true;
|
|
|
108 return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
|
|
|
109 }
|
|
|
110 bool operator()(const evaluate::Substring &substring) {
|
|
|
111 hasSubscript_ = true;
|
|
|
112 return (*this)(substring.parent()) && (*this)(substring.lower()) &&
|
|
|
113 (*this)(substring.upper());
|
|
|
114 }
|
|
|
115 bool operator()(const evaluate::CoarrayRef &) { // C874
|
|
|
116 context_.Say(
|
|
|
117 source_, "Data object must not be a coindexed variable"_err_en_US);
|
|
|
118 return false;
|
|
173
|
119 }
|
|
|
120 bool operator()(const evaluate::Subscript &subs) {
|
|
207
|
121 DataVarChecker subscriptChecker{context_, source_};
|
|
|
122 subscriptChecker.RestrictPointer();
|
|
173
|
123 return std::visit(
|
|
207
|
124 common::visitors{
|
|
|
125 [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
|
|
|
126 return CheckSubscriptExpr(expr);
|
|
|
127 },
|
|
|
128 [&](const evaluate::Triplet &triplet) {
|
|
|
129 return CheckSubscriptExpr(triplet.lower()) &&
|
|
|
130 CheckSubscriptExpr(triplet.upper()) &&
|
|
|
131 CheckSubscriptExpr(triplet.stride());
|
|
|
132 },
|
|
|
133 },
|
|
|
134 subs.u) &&
|
|
|
135 subscriptChecker(subs.u);
|
|
173
|
136 }
|
|
|
137 template <typename T>
|
|
|
138 bool operator()(const evaluate::FunctionRef<T> &) const { // C875
|
|
|
139 context_.Say(source_,
|
|
|
140 "Data object variable must not be a function reference"_err_en_US);
|
|
|
141 return false;
|
|
|
142 }
|
|
207
|
143 void RestrictPointer() { isPointerAllowed_ = false; }
|
|
173
|
144
|
|
|
145 private:
|
|
|
146 bool CheckSubscriptExpr(
|
|
|
147 const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
|
|
|
148 return !x || CheckSubscriptExpr(*x);
|
|
|
149 }
|
|
|
150 bool CheckSubscriptExpr(
|
|
|
151 const evaluate::IndirectSubscriptIntegerExpr &expr) const {
|
|
|
152 return CheckSubscriptExpr(expr.value());
|
|
|
153 }
|
|
|
154 bool CheckSubscriptExpr(
|
|
|
155 const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
|
|
|
156 if (!evaluate::IsConstantExpr(expr)) { // C875,C881
|
|
|
157 context_.Say(
|
|
|
158 source_, "Data object must have constant subscripts"_err_en_US);
|
|
|
159 return false;
|
|
|
160 } else {
|
|
|
161 return true;
|
|
|
162 }
|
|
|
163 }
|
|
|
164
|
|
|
165 SemanticsContext &context_;
|
|
|
166 parser::CharBlock source_;
|
|
|
167 bool hasComponent_{false};
|
|
|
168 bool hasSubscript_{false};
|
|
207
|
169 bool isPointerAllowed_{true};
|
|
|
170 bool isFirstSymbol_{true};
|
|
173
|
171 };
|
|
|
172
|
|
|
173 void DataChecker::Leave(const parser::DataIDoObject &object) {
|
|
|
174 if (const auto *designator{
|
|
|
175 std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
|
|
|
176 &object.u)}) {
|
|
|
177 if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
|
|
|
178 auto source{designator->thing.value().source};
|
|
207
|
179 if (evaluate::IsConstantExpr(*expr)) { // C878,C879
|
|
|
180 exprAnalyzer_.context().Say(
|
|
173
|
181 source, "Data implied do object must be a variable"_err_en_US);
|
|
|
182 } else {
|
|
|
183 DataVarChecker checker{exprAnalyzer_.context(), source};
|
|
207
|
184 if (checker(*expr)) {
|
|
|
185 if (checker.HasComponentWithoutSubscripts()) { // C880
|
|
|
186 exprAnalyzer_.context().Say(source,
|
|
|
187 "Data implied do structure component must be subscripted"_err_en_US);
|
|
|
188 } else {
|
|
|
189 return;
|
|
|
190 }
|
|
173
|
191 }
|
|
|
192 }
|
|
|
193 }
|
|
207
|
194 currentSetHasFatalErrors_ = true;
|
|
173
|
195 }
|
|
|
196 }
|
|
|
197
|
|
|
198 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
|
|
207
|
199 std::visit(common::visitors{
|
|
|
200 [](const parser::DataImpliedDo &) { // has own Enter()/Leave()
|
|
|
201 },
|
|
|
202 [&](const auto &var) {
|
|
|
203 auto expr{exprAnalyzer_.Analyze(var)};
|
|
|
204 if (!expr ||
|
|
|
205 !DataVarChecker{exprAnalyzer_.context(),
|
|
|
206 parser::FindSourceLocation(dataObject)}(*expr)) {
|
|
|
207 currentSetHasFatalErrors_ = true;
|
|
|
208 }
|
|
|
209 },
|
|
|
210 },
|
|
|
211 dataObject.u);
|
|
173
|
212 }
|
|
|
213
|
|
207
|
214 void DataChecker::Leave(const parser::DataStmtSet &set) {
|
|
|
215 if (!currentSetHasFatalErrors_) {
|
|
|
216 AccumulateDataInitializations(inits_, exprAnalyzer_, set);
|
|
173
|
217 }
|
|
207
|
218 currentSetHasFatalErrors_ = false;
|
|
173
|
219 }
|
|
207
|
220
|
|
|
221 void DataChecker::CompileDataInitializationsIntoInitializers() {
|
|
|
222 ConvertToInitializers(inits_, exprAnalyzer_);
|
|
|
223 }
|
|
|
224
|
|
173
|
225 } // namespace Fortran::semantics
|
