280 lines · cpp
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-exception6//7//===----------------------------------------------------------------------===//8 9// DATA statement semantic analysis.10// - Applies static semantic checks to the variables in each data-stmt-set with11// class DataVarChecker;12// - Invokes conversion of DATA statement values to static initializers13 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 23namespace Fortran::semantics {24 25// Ensures that references to an implied DO loop control variable are26// represented as such in the "body" of the implied DO loop.27void DataChecker::Enter(const parser::DataImpliedDo &x) {28 const auto &name{parser::UnwrapRef<parser::Name>(29 std::get<parser::DataImpliedDo::Bounds>(x.t).name)};30 int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};31 if (const auto dynamicType{evaluate::DynamicType::From(DEREF(name.symbol))}) {32 if (dynamicType->category() == TypeCategory::Integer) {33 kind = dynamicType->kind();34 }35 }36 exprAnalyzer_.AddImpliedDo(name.source, kind);37}38 39void DataChecker::Leave(const parser::DataImpliedDo &x) {40 const auto &name{parser::UnwrapRef<parser::Name>(41 std::get<parser::DataImpliedDo::Bounds>(x.t).name)};42 exprAnalyzer_.RemoveImpliedDo(name.source);43}44 45// DataVarChecker applies static checks once to each variable that appears46// in a data-stmt-set. These checks are independent of the values that47// correspond to the variables.48class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {49public:50 using Base = evaluate::AllTraverse<DataVarChecker, true>;51 DataVarChecker(SemanticsContext &c, parser::CharBlock src)52 : Base{*this}, context_{c}, source_{src} {}53 using Base::operator();54 bool HasComponentWithoutSubscripts() const {55 return hasComponent_ && !hasSubscript_;56 }57 bool operator()(const Symbol &symbol) { // C87658 // 8.6.7p(2) - precludes non-pointers of derived types with59 // default component values60 const Scope &scope{context_.FindScope(source_)};61 bool isFirstSymbol{isFirstSymbol_};62 isFirstSymbol_ = false;63 // Ordered so that most egregious errors are first64 if (const char *whyNot{IsProcedure(symbol) && !IsPointer(symbol)65 ? "Procedure"66 : isFirstSymbol && IsHostAssociated(symbol, scope)67 ? "Host-associated object"68 : isFirstSymbol && IsUseAssociated(symbol, scope)69 ? "USE-associated object"70 : IsDummy(symbol) ? "Dummy argument"71 : IsFunctionResult(symbol) ? "Function result"72 : IsAutomatic(symbol) ? "Automatic variable"73 : IsAllocatable(symbol) ? "Allocatable"74 : IsInitialized(symbol, true /*ignore DATA*/,75 true /*ignore allocatable components*/,76 true /*ignore uninitialized pointer components*/)77 ? "Default-initialized"78 : symbol.has<AssocEntityDetails>() ? "Construct association"79 : isFirstSymbol && IsPointer(symbol) &&80 (hasComponent_ || hasSubscript_)81 ? "Target of pointer"82 : nullptr}) {83 context_.Say(source_,84 "%s '%s' must not be initialized in a DATA statement"_err_en_US,85 whyNot, symbol.name());86 return false;87 }88 if (IsProcedurePointer(symbol)) {89 if (!context_.IsEnabled(common::LanguageFeature::DataStmtExtensions)) {90 context_.Say(source_,91 "Procedure pointer '%s' may not appear in a DATA statement"_err_en_US,92 symbol.name());93 return false;94 } else {95 context_.Warn(common::LanguageFeature::DataStmtExtensions, source_,96 "Procedure pointer '%s' in a DATA statement is not standard"_port_en_US,97 symbol.name());98 }99 }100 if (IsInBlankCommon(symbol)) {101 if (!context_.IsEnabled(common::LanguageFeature::DataStmtExtensions)) {102 context_.Say(source_,103 "Blank COMMON object '%s' may not appear in a DATA statement"_err_en_US,104 symbol.name());105 return false;106 } else {107 context_.Warn(common::LanguageFeature::DataStmtExtensions, source_,108 "Blank COMMON object '%s' in a DATA statement is not standard"_port_en_US,109 symbol.name());110 }111 }112 return true;113 }114 bool operator()(const evaluate::Component &component) {115 hasComponent_ = true;116 const Symbol &lastSymbol{component.GetLastSymbol()};117 if (isPointerAllowed_) {118 if (IsPointer(lastSymbol) && hasSubscript_) { // C877119 context_.Say(source_,120 "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,121 lastSymbol.name().ToString());122 return false;123 }124 auto restorer{common::ScopedSet(isPointerAllowed_, false)};125 return (*this)(component.base()) && (*this)(lastSymbol);126 } else if (IsPointer(lastSymbol)) { // C877127 context_.Say(source_,128 "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,129 lastSymbol.name().ToString());130 return false;131 } else {132 return (*this)(component.base()) && (*this)(lastSymbol);133 }134 }135 bool operator()(const evaluate::ArrayRef &arrayRef) {136 hasSubscript_ = true;137 return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());138 }139 bool operator()(const evaluate::Substring &substring) {140 hasSubscript_ = true;141 return (*this)(substring.parent()) && (*this)(substring.lower()) &&142 (*this)(substring.upper());143 }144 bool operator()(const evaluate::CoarrayRef &) { // C874145 context_.Say(146 source_, "Data object must not be a coindexed variable"_err_en_US);147 return false;148 }149 bool operator()(const evaluate::Subscript &subs) {150 auto restorer1{common::ScopedSet(isPointerAllowed_, false)};151 auto restorer2{common::ScopedSet(isFunctionAllowed_, true)};152 return common::visit(153 common::visitors{154 [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {155 return CheckSubscriptExpr(expr);156 },157 [&](const evaluate::Triplet &triplet) {158 return CheckSubscriptExpr(triplet.lower()) &&159 CheckSubscriptExpr(triplet.upper()) &&160 CheckSubscriptExpr(triplet.stride());161 },162 },163 subs.u);164 }165 template <typename T>166 bool operator()(const evaluate::FunctionRef<T> &) const { // C875167 if (isFunctionAllowed_) {168 // Must have been validated as a constant expression169 return true;170 } else {171 context_.Say(source_,172 "Data object variable must not be a function reference"_err_en_US);173 return false;174 }175 }176 177private:178 bool CheckSubscriptExpr(179 const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {180 return !x || CheckSubscriptExpr(*x);181 }182 bool CheckSubscriptExpr(183 const evaluate::IndirectSubscriptIntegerExpr &expr) const {184 return CheckSubscriptExpr(expr.value());185 }186 bool CheckSubscriptExpr(187 const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {188 if (!evaluate::IsConstantExpr(expr)) { // C875,C881189 context_.Say(190 source_, "Data object must have constant subscripts"_err_en_US);191 return false;192 } else {193 return true;194 }195 }196 197 SemanticsContext &context_;198 parser::CharBlock source_;199 bool hasComponent_{false};200 bool hasSubscript_{false};201 bool isPointerAllowed_{true};202 bool isFirstSymbol_{true};203 bool isFunctionAllowed_{false};204};205 206static bool IsValidDataObject(const SomeExpr &expr) { // C878, C879207 return !evaluate::IsConstantExpr(expr) &&208 (evaluate::IsVariable(expr) || evaluate::IsProcedurePointer(expr));209}210 211void DataChecker::Leave(const parser::DataIDoObject &object) {212 if (const auto *designator{213 std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(214 &object.u)}) {215 if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {216 auto source{parser::UnwrapRef<parser::Designator>(*designator).source};217 DataVarChecker checker{exprAnalyzer_.context(), source};218 if (checker(*expr)) {219 if (checker.HasComponentWithoutSubscripts()) { // C880220 exprAnalyzer_.context().Say(source,221 "Data implied do structure component must be subscripted"_err_en_US);222 } else if (!IsValidDataObject(*expr)) {223 exprAnalyzer_.context().Say(224 source, "Data implied do object must be a variable"_err_en_US);225 } else {226 return;227 }228 }229 }230 currentSetHasFatalErrors_ = true;231 }232}233 234void DataChecker::Leave(const parser::DataStmtObject &dataObject) {235 common::visit(236 common::visitors{237 [](const parser::DataImpliedDo &) { // has own Enter()/Leave()238 },239 [&](const auto &var) {240 auto expr{exprAnalyzer_.Analyze(var)};241 auto source{parser::FindSourceLocation(dataObject)};242 if (!expr ||243 !DataVarChecker{exprAnalyzer_.context(), source}(*expr)) {244 currentSetHasFatalErrors_ = true;245 } else if (!IsValidDataObject(*expr)) {246 exprAnalyzer_.context().Say(247 source, "Data statement object must be a variable"_err_en_US);248 currentSetHasFatalErrors_ = true;249 }250 },251 },252 dataObject.u);253}254 255void DataChecker::Leave(const parser::DataStmtSet &set) {256 if (!currentSetHasFatalErrors_) {257 AccumulateDataInitializations(inits_, exprAnalyzer_, set);258 }259 currentSetHasFatalErrors_ = false;260}261 262void DataChecker::Leave(const parser::EntityDecl &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 275void DataChecker::CompileDataInitializationsIntoInitializers() {276 ConvertToInitializers(inits_, exprAnalyzer_);277}278 279} // namespace Fortran::semantics280