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 RestrictPointer(); 106 } else { 107 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 } 113 } 114 return (*this)(component.base()) && (*this)(lastSymbol); 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 DataVarChecker subscriptChecker{context_, source_}; 132 subscriptChecker.RestrictPointer(); 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 subscriptChecker(subs.u); 146 } 147 template <typename T> 148 bool operator()(const evaluate::FunctionRef<T> &) const { // C875 149 context_.Say(source_, 150 "Data object variable must not be a function reference"_err_en_US); 151 return false; 152 } 153 void RestrictPointer() { isPointerAllowed_ = false; } 154 155 private: 156 bool CheckSubscriptExpr( 157 const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const { 158 return !x || CheckSubscriptExpr(*x); 159 } 160 bool CheckSubscriptExpr( 161 const evaluate::IndirectSubscriptIntegerExpr &expr) const { 162 return CheckSubscriptExpr(expr.value()); 163 } 164 bool CheckSubscriptExpr( 165 const evaluate::Expr<evaluate::SubscriptInteger> &expr) const { 166 if (!evaluate::IsConstantExpr(expr)) { // C875,C881 167 context_.Say( 168 source_, "Data object must have constant subscripts"_err_en_US); 169 return false; 170 } else { 171 return true; 172 } 173 } 174 175 SemanticsContext &context_; 176 parser::CharBlock source_; 177 bool hasComponent_{false}; 178 bool hasSubscript_{false}; 179 bool isPointerAllowed_{true}; 180 bool isFirstSymbol_{true}; 181 }; 182 183 static bool IsValidDataObject(const SomeExpr &expr) { // C878, C879 184 return !evaluate::IsConstantExpr(expr) && 185 (evaluate::IsVariable(expr) || evaluate::IsProcedurePointer(expr)); 186 } 187 188 void DataChecker::Leave(const parser::DataIDoObject &object) { 189 if (const auto *designator{ 190 std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>( 191 &object.u)}) { 192 if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) { 193 auto source{designator->thing.value().source}; 194 DataVarChecker checker{exprAnalyzer_.context(), source}; 195 if (checker(*expr)) { 196 if (checker.HasComponentWithoutSubscripts()) { // C880 197 exprAnalyzer_.context().Say(source, 198 "Data implied do structure component must be subscripted"_err_en_US); 199 } else if (!IsValidDataObject(*expr)) { 200 exprAnalyzer_.context().Say( 201 source, "Data implied do object must be a variable"_err_en_US); 202 } else { 203 return; 204 } 205 } 206 } 207 currentSetHasFatalErrors_ = true; 208 } 209 } 210 211 void DataChecker::Leave(const parser::DataStmtObject &dataObject) { 212 common::visit( 213 common::visitors{ 214 [](const parser::DataImpliedDo &) { // has own Enter()/Leave() 215 }, 216 [&](const auto &var) { 217 auto expr{exprAnalyzer_.Analyze(var)}; 218 auto source{parser::FindSourceLocation(dataObject)}; 219 if (!expr || 220 !DataVarChecker{exprAnalyzer_.context(), source}(*expr)) { 221 currentSetHasFatalErrors_ = true; 222 } else if (!IsValidDataObject(*expr)) { 223 exprAnalyzer_.context().Say( 224 source, "Data statement object must be a variable"_err_en_US); 225 currentSetHasFatalErrors_ = true; 226 } 227 }, 228 }, 229 dataObject.u); 230 } 231 232 void DataChecker::Leave(const parser::DataStmtSet &set) { 233 if (!currentSetHasFatalErrors_) { 234 AccumulateDataInitializations(inits_, exprAnalyzer_, set); 235 } 236 currentSetHasFatalErrors_ = false; 237 } 238 239 // Handle legacy DATA-style initialization, e.g. REAL PI/3.14159/, for 240 // variables and components (esp. for DEC STRUCTUREs) 241 template <typename A> void DataChecker::LegacyDataInit(const A &decl) { 242 if (const auto &init{ 243 std::get<std::optional<parser::Initialization>>(decl.t)}) { 244 const Symbol *name{std::get<parser::Name>(decl.t).symbol}; 245 const auto *list{ 246 std::get_if<std::list<common::Indirection<parser::DataStmtValue>>>( 247 &init->u)}; 248 if (name && list) { 249 AccumulateDataInitializations(inits_, exprAnalyzer_, *name, *list); 250 } 251 } 252 } 253 254 void DataChecker::Leave(const parser::ComponentDecl &decl) { 255 LegacyDataInit(decl); 256 } 257 258 void DataChecker::Leave(const parser::EntityDecl &decl) { 259 LegacyDataInit(decl); 260 } 261 262 void DataChecker::CompileDataInitializationsIntoInitializers() { 263 ConvertToInitializers(inits_, exprAnalyzer_); 264 } 265 266 } // namespace Fortran::semantics 267