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