xref: /llvm-project/flang/lib/Semantics/check-data.cpp (revision 7e013d6034bd8e81a6434f515f545b4375078512)
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 
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 
14 #include "check-data.h"
15 #include "data-to-inits.h"
16 #include "flang/Evaluate/traverse.h"
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>
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)}) {
31     if (dynamicType->category() == TypeCategory::Integer) {
32       kind = dynamicType->kind();
33     }
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 
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.
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   }
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 /*ignore DATA*/,
66                       true /*ignore allocatable components*/,
67                       true /*ignore uninitialized pointer components*/)
68                 ? "Default-initialized"
69                 : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
70                 // remaining checks don't apply to components
71                 : !isFirstSymbol                   ? nullptr
72                 : IsHostAssociated(symbol, scope)  ? "Host-associated object"
73                 : IsUseAssociated(symbol, scope)   ? "USE-associated object"
74                 : symbol.has<AssocEntityDetails>() ? "Construct association"
75                 : IsPointer(symbol) && (hasComponent_ || hasSubscript_)
76                 ? "Target of pointer"
77                 : nullptr}) {
78       context_.Say(source_,
79           "%s '%s' must not be initialized in a DATA statement"_err_en_US,
80           whyNot, symbol.name());
81       return false;
82     }
83     if (IsProcedurePointer(symbol)) {
84       context_.Say(source_,
85           "Procedure pointer '%s' in a DATA statement is not standard"_port_en_US,
86           symbol.name());
87     }
88     if (IsInBlankCommon(symbol)) {
89       context_.Say(source_,
90           "Blank COMMON object '%s' in a DATA statement is not standard"_port_en_US,
91           symbol.name());
92     }
93     return true;
94   }
95   bool operator()(const evaluate::Component &component) {
96     hasComponent_ = true;
97     const Symbol &lastSymbol{component.GetLastSymbol()};
98     if (isPointerAllowed_) {
99       if (IsPointer(lastSymbol) && hasSubscript_) { // C877
100         context_.Say(source_,
101             "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
102             lastSymbol.name().ToString());
103         return false;
104       }
105       auto restorer{common::ScopedSet(isPointerAllowed_, false)};
106       return (*this)(component.base()) && (*this)(lastSymbol);
107     } else if (IsPointer(lastSymbol)) { // C877
108       context_.Say(source_,
109           "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
110           lastSymbol.name().ToString());
111       return false;
112     } else {
113       return (*this)(component.base()) && (*this)(lastSymbol);
114     }
115   }
116   bool operator()(const evaluate::ArrayRef &arrayRef) {
117     hasSubscript_ = true;
118     return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
119   }
120   bool operator()(const evaluate::Substring &substring) {
121     hasSubscript_ = true;
122     return (*this)(substring.parent()) && (*this)(substring.lower()) &&
123         (*this)(substring.upper());
124   }
125   bool operator()(const evaluate::CoarrayRef &) { // C874
126     context_.Say(
127         source_, "Data object must not be a coindexed variable"_err_en_US);
128     return false;
129   }
130   bool operator()(const evaluate::Subscript &subs) {
131     auto restorer1{common::ScopedSet(isPointerAllowed_, false)};
132     auto restorer2{common::ScopedSet(isFunctionAllowed_, true)};
133     return common::visit(
134         common::visitors{
135             [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
136               return CheckSubscriptExpr(expr);
137             },
138             [&](const evaluate::Triplet &triplet) {
139               return CheckSubscriptExpr(triplet.lower()) &&
140                   CheckSubscriptExpr(triplet.upper()) &&
141                   CheckSubscriptExpr(triplet.stride());
142             },
143         },
144         subs.u);
145   }
146   template <typename T>
147   bool operator()(const evaluate::FunctionRef<T> &) const { // C875
148     if (isFunctionAllowed_) {
149       // Must have been validated as a constant expression
150       return true;
151     } else {
152       context_.Say(source_,
153           "Data object variable must not be a function reference"_err_en_US);
154       return false;
155     }
156   }
157 
158 private:
159   bool CheckSubscriptExpr(
160       const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
161     return !x || CheckSubscriptExpr(*x);
162   }
163   bool CheckSubscriptExpr(
164       const evaluate::IndirectSubscriptIntegerExpr &expr) const {
165     return CheckSubscriptExpr(expr.value());
166   }
167   bool CheckSubscriptExpr(
168       const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
169     if (!evaluate::IsConstantExpr(expr)) { // C875,C881
170       context_.Say(
171           source_, "Data object must have constant subscripts"_err_en_US);
172       return false;
173     } else {
174       return true;
175     }
176   }
177 
178   SemanticsContext &context_;
179   parser::CharBlock source_;
180   bool hasComponent_{false};
181   bool hasSubscript_{false};
182   bool isPointerAllowed_{true};
183   bool isFirstSymbol_{true};
184   bool isFunctionAllowed_{false};
185 };
186 
187 static bool IsValidDataObject(const SomeExpr &expr) { // C878, C879
188   return !evaluate::IsConstantExpr(expr) &&
189       (evaluate::IsVariable(expr) || evaluate::IsProcedurePointer(expr));
190 }
191 
192 void DataChecker::Leave(const parser::DataIDoObject &object) {
193   if (const auto *designator{
194           std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
195               &object.u)}) {
196     if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
197       auto source{designator->thing.value().source};
198       DataVarChecker checker{exprAnalyzer_.context(), source};
199       if (checker(*expr)) {
200         if (checker.HasComponentWithoutSubscripts()) { // C880
201           exprAnalyzer_.context().Say(source,
202               "Data implied do structure component must be subscripted"_err_en_US);
203         } else if (!IsValidDataObject(*expr)) {
204           exprAnalyzer_.context().Say(
205               source, "Data implied do object must be a variable"_err_en_US);
206         } else {
207           return;
208         }
209       }
210     }
211     currentSetHasFatalErrors_ = true;
212   }
213 }
214 
215 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
216   common::visit(
217       common::visitors{
218           [](const parser::DataImpliedDo &) { // has own Enter()/Leave()
219           },
220           [&](const auto &var) {
221             auto expr{exprAnalyzer_.Analyze(var)};
222             auto source{parser::FindSourceLocation(dataObject)};
223             if (!expr ||
224                 !DataVarChecker{exprAnalyzer_.context(), source}(*expr)) {
225               currentSetHasFatalErrors_ = true;
226             } else if (!IsValidDataObject(*expr)) {
227               exprAnalyzer_.context().Say(
228                   source, "Data statement object must be a variable"_err_en_US);
229               currentSetHasFatalErrors_ = true;
230             }
231           },
232       },
233       dataObject.u);
234 }
235 
236 void DataChecker::Leave(const parser::DataStmtSet &set) {
237   if (!currentSetHasFatalErrors_) {
238     AccumulateDataInitializations(inits_, exprAnalyzer_, set);
239   }
240   currentSetHasFatalErrors_ = false;
241 }
242 
243 // Handle legacy DATA-style initialization, e.g. REAL PI/3.14159/, for
244 // variables and components (esp. for DEC STRUCTUREs)
245 template <typename A> void DataChecker::LegacyDataInit(const A &decl) {
246   if (const auto &init{
247           std::get<std::optional<parser::Initialization>>(decl.t)}) {
248     const Symbol *name{std::get<parser::Name>(decl.t).symbol};
249     const auto *list{
250         std::get_if<std::list<common::Indirection<parser::DataStmtValue>>>(
251             &init->u)};
252     if (name && list) {
253       AccumulateDataInitializations(inits_, exprAnalyzer_, *name, *list);
254     }
255   }
256 }
257 
258 void DataChecker::Leave(const parser::ComponentDecl &decl) {
259   LegacyDataInit(decl);
260 }
261 
262 void DataChecker::Leave(const parser::EntityDecl &decl) {
263   LegacyDataInit(decl);
264 }
265 
266 void DataChecker::CompileDataInitializationsIntoInitializers() {
267   ConvertToInitializers(inits_, exprAnalyzer_);
268 }
269 
270 } // namespace Fortran::semantics
271