225 lines
8.3 KiB
C++
225 lines
8.3 KiB
C++
//===-- lib/Semantics/check-data.cpp --------------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
// DATA statement semantic analysis.
|
|
// - Applies static semantic checks to the variables in each data-stmt-set with
|
|
// class DataVarChecker;
|
|
// - Invokes conversion of DATA statement values to static initializers
|
|
|
|
#include "check-data.h"
|
|
#include "data-to-inits.h"
|
|
#include "flang/Evaluate/traverse.h"
|
|
#include "flang/Parser/parse-tree.h"
|
|
#include "flang/Parser/tools.h"
|
|
#include "flang/Semantics/tools.h"
|
|
#include <algorithm>
|
|
#include <vector>
|
|
|
|
namespace Fortran::semantics {
|
|
|
|
// Ensures that references to an implied DO loop control variable are
|
|
// represented as such in the "body" of the implied DO loop.
|
|
void DataChecker::Enter(const parser::DataImpliedDo &x) {
|
|
auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
|
|
int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
|
|
if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
|
|
if (dynamicType->category() == TypeCategory::Integer) {
|
|
kind = dynamicType->kind();
|
|
}
|
|
}
|
|
exprAnalyzer_.AddImpliedDo(name.source, kind);
|
|
}
|
|
|
|
void DataChecker::Leave(const parser::DataImpliedDo &x) {
|
|
auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
|
|
exprAnalyzer_.RemoveImpliedDo(name.source);
|
|
}
|
|
|
|
// DataVarChecker applies static checks once to each variable that appears
|
|
// in a data-stmt-set. These checks are independent of the values that
|
|
// correspond to the variables.
|
|
class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
|
|
public:
|
|
using Base = evaluate::AllTraverse<DataVarChecker, true>;
|
|
DataVarChecker(SemanticsContext &c, parser::CharBlock src)
|
|
: Base{*this}, context_{c}, source_{src} {}
|
|
using Base::operator();
|
|
bool HasComponentWithoutSubscripts() const {
|
|
return hasComponent_ && !hasSubscript_;
|
|
}
|
|
bool operator()(const Symbol &symbol) { // C876
|
|
// 8.6.7p(2) - precludes non-pointers of derived types with
|
|
// default component values
|
|
const Scope &scope{context_.FindScope(source_)};
|
|
bool isFirstSymbol{isFirstSymbol_};
|
|
isFirstSymbol_ = false;
|
|
if (const char *whyNot{IsAutomatic(symbol) ? "Automatic variable"
|
|
: IsDummy(symbol) ? "Dummy argument"
|
|
: IsFunctionResult(symbol) ? "Function result"
|
|
: IsAllocatable(symbol) ? "Allocatable"
|
|
: IsInitialized(symbol, true) ? "Default-initialized"
|
|
: IsInBlankCommon(symbol) ? "Blank COMMON object"
|
|
: IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
|
|
// remaining checks don't apply to components
|
|
: !isFirstSymbol ? nullptr
|
|
: IsHostAssociated(symbol, scope) ? "Host-associated object"
|
|
: IsUseAssociated(symbol, scope) ? "USE-associated object"
|
|
: nullptr}) {
|
|
context_.Say(source_,
|
|
"%s '%s' must not be initialized in a DATA statement"_err_en_US,
|
|
whyNot, symbol.name());
|
|
return false;
|
|
} else if (IsProcedurePointer(symbol)) {
|
|
context_.Say(source_,
|
|
"Procedure pointer '%s' in a DATA statement is not standard"_en_US,
|
|
symbol.name());
|
|
}
|
|
return true;
|
|
}
|
|
bool operator()(const evaluate::Component &component) {
|
|
hasComponent_ = true;
|
|
const Symbol &lastSymbol{component.GetLastSymbol()};
|
|
if (isPointerAllowed_) {
|
|
if (IsPointer(lastSymbol) && hasSubscript_) { // C877
|
|
context_.Say(source_,
|
|
"Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
|
|
lastSymbol.name().ToString());
|
|
return false;
|
|
}
|
|
RestrictPointer();
|
|
} else {
|
|
if (IsPointer(lastSymbol)) { // C877
|
|
context_.Say(source_,
|
|
"Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
|
|
lastSymbol.name().ToString());
|
|
return false;
|
|
}
|
|
}
|
|
return (*this)(component.base()) && (*this)(lastSymbol);
|
|
}
|
|
bool operator()(const evaluate::ArrayRef &arrayRef) {
|
|
hasSubscript_ = true;
|
|
return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
|
|
}
|
|
bool operator()(const evaluate::Substring &substring) {
|
|
hasSubscript_ = true;
|
|
return (*this)(substring.parent()) && (*this)(substring.lower()) &&
|
|
(*this)(substring.upper());
|
|
}
|
|
bool operator()(const evaluate::CoarrayRef &) { // C874
|
|
context_.Say(
|
|
source_, "Data object must not be a coindexed variable"_err_en_US);
|
|
return false;
|
|
}
|
|
bool operator()(const evaluate::Subscript &subs) {
|
|
DataVarChecker subscriptChecker{context_, source_};
|
|
subscriptChecker.RestrictPointer();
|
|
return std::visit(
|
|
common::visitors{
|
|
[&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
|
|
return CheckSubscriptExpr(expr);
|
|
},
|
|
[&](const evaluate::Triplet &triplet) {
|
|
return CheckSubscriptExpr(triplet.lower()) &&
|
|
CheckSubscriptExpr(triplet.upper()) &&
|
|
CheckSubscriptExpr(triplet.stride());
|
|
},
|
|
},
|
|
subs.u) &&
|
|
subscriptChecker(subs.u);
|
|
}
|
|
template <typename T>
|
|
bool operator()(const evaluate::FunctionRef<T> &) const { // C875
|
|
context_.Say(source_,
|
|
"Data object variable must not be a function reference"_err_en_US);
|
|
return false;
|
|
}
|
|
void RestrictPointer() { isPointerAllowed_ = false; }
|
|
|
|
private:
|
|
bool CheckSubscriptExpr(
|
|
const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
|
|
return !x || CheckSubscriptExpr(*x);
|
|
}
|
|
bool CheckSubscriptExpr(
|
|
const evaluate::IndirectSubscriptIntegerExpr &expr) const {
|
|
return CheckSubscriptExpr(expr.value());
|
|
}
|
|
bool CheckSubscriptExpr(
|
|
const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
|
|
if (!evaluate::IsConstantExpr(expr)) { // C875,C881
|
|
context_.Say(
|
|
source_, "Data object must have constant subscripts"_err_en_US);
|
|
return false;
|
|
} else {
|
|
return true;
|
|
}
|
|
}
|
|
|
|
SemanticsContext &context_;
|
|
parser::CharBlock source_;
|
|
bool hasComponent_{false};
|
|
bool hasSubscript_{false};
|
|
bool isPointerAllowed_{true};
|
|
bool isFirstSymbol_{true};
|
|
};
|
|
|
|
void DataChecker::Leave(const parser::DataIDoObject &object) {
|
|
if (const auto *designator{
|
|
std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
|
|
&object.u)}) {
|
|
if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
|
|
auto source{designator->thing.value().source};
|
|
if (evaluate::IsConstantExpr(*expr)) { // C878,C879
|
|
exprAnalyzer_.context().Say(
|
|
source, "Data implied do object must be a variable"_err_en_US);
|
|
} else {
|
|
DataVarChecker checker{exprAnalyzer_.context(), source};
|
|
if (checker(*expr)) {
|
|
if (checker.HasComponentWithoutSubscripts()) { // C880
|
|
exprAnalyzer_.context().Say(source,
|
|
"Data implied do structure component must be subscripted"_err_en_US);
|
|
} else {
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
currentSetHasFatalErrors_ = true;
|
|
}
|
|
}
|
|
|
|
void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
|
|
std::visit(common::visitors{
|
|
[](const parser::DataImpliedDo &) { // has own Enter()/Leave()
|
|
},
|
|
[&](const auto &var) {
|
|
auto expr{exprAnalyzer_.Analyze(var)};
|
|
if (!expr ||
|
|
!DataVarChecker{exprAnalyzer_.context(),
|
|
parser::FindSourceLocation(dataObject)}(*expr)) {
|
|
currentSetHasFatalErrors_ = true;
|
|
}
|
|
},
|
|
},
|
|
dataObject.u);
|
|
}
|
|
|
|
void DataChecker::Leave(const parser::DataStmtSet &set) {
|
|
if (!currentSetHasFatalErrors_) {
|
|
AccumulateDataInitializations(inits_, exprAnalyzer_, set);
|
|
}
|
|
currentSetHasFatalErrors_ = false;
|
|
}
|
|
|
|
void DataChecker::CompileDataInitializationsIntoInitializers() {
|
|
ConvertToInitializers(inits_, exprAnalyzer_);
|
|
}
|
|
|
|
} // namespace Fortran::semantics
|