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