|
173
|
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 #include "check-data.h"
|
|
|
10 #include "flang/Evaluate/traverse.h"
|
|
|
11 #include "flang/Semantics/expression.h"
|
|
|
12
|
|
|
13 namespace Fortran::semantics {
|
|
|
14
|
|
|
15 void DataChecker::Leave(const parser::DataStmtConstant &dataConst) {
|
|
|
16 if (auto *structure{
|
|
|
17 std::get_if<parser::StructureConstructor>(&dataConst.u)}) {
|
|
|
18 for (const auto &component :
|
|
|
19 std::get<std::list<parser::ComponentSpec>>(structure->t)) {
|
|
|
20 const parser::Expr &parsedExpr{
|
|
|
21 std::get<parser::ComponentDataSource>(component.t).v.value()};
|
|
|
22 if (const auto *expr{GetExpr(parsedExpr)}) {
|
|
|
23 if (!evaluate::IsConstantExpr(*expr)) { // C884
|
|
|
24 exprAnalyzer_.Say(parsedExpr.source,
|
|
|
25 "Structure constructor in data value must be a constant expression"_err_en_US);
|
|
|
26 }
|
|
|
27 }
|
|
|
28 }
|
|
|
29 }
|
|
|
30 }
|
|
|
31
|
|
|
32 // Ensures that references to an implied DO loop control variable are
|
|
|
33 // represented as such in the "body" of the implied DO loop.
|
|
|
34 void DataChecker::Enter(const parser::DataImpliedDo &x) {
|
|
|
35 auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
|
|
|
36 int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
|
|
|
37 if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
|
|
|
38 kind = dynamicType->kind();
|
|
|
39 }
|
|
|
40 exprAnalyzer_.AddImpliedDo(name.source, kind);
|
|
|
41 }
|
|
|
42
|
|
|
43 void DataChecker::Leave(const parser::DataImpliedDo &x) {
|
|
|
44 auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
|
|
|
45 exprAnalyzer_.RemoveImpliedDo(name.source);
|
|
|
46 }
|
|
|
47
|
|
|
48 class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
|
|
|
49 public:
|
|
|
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 evaluate::Component &component) {
|
|
|
58 hasComponent_ = true;
|
|
|
59 return (*this)(component.base());
|
|
|
60 }
|
|
|
61 bool operator()(const evaluate::Subscript &subs) {
|
|
|
62 hasSubscript_ = true;
|
|
|
63 return std::visit(
|
|
|
64 common::visitors{
|
|
|
65 [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
|
|
|
66 return CheckSubscriptExpr(expr);
|
|
|
67 },
|
|
|
68 [&](const evaluate::Triplet &triplet) {
|
|
|
69 return CheckSubscriptExpr(triplet.lower()) &&
|
|
|
70 CheckSubscriptExpr(triplet.upper()) &&
|
|
|
71 CheckSubscriptExpr(triplet.stride());
|
|
|
72 },
|
|
|
73 },
|
|
|
74 subs.u);
|
|
|
75 }
|
|
|
76 template <typename T>
|
|
|
77 bool operator()(const evaluate::FunctionRef<T> &) const { // C875
|
|
|
78 context_.Say(source_,
|
|
|
79 "Data object variable must not be a function reference"_err_en_US);
|
|
|
80 return false;
|
|
|
81 }
|
|
|
82 bool operator()(const evaluate::CoarrayRef &) const { // C874
|
|
|
83 context_.Say(
|
|
|
84 source_, "Data object must not be a coindexed variable"_err_en_US);
|
|
|
85 return false;
|
|
|
86 }
|
|
|
87
|
|
|
88 private:
|
|
|
89 bool CheckSubscriptExpr(
|
|
|
90 const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
|
|
|
91 return !x || CheckSubscriptExpr(*x);
|
|
|
92 }
|
|
|
93 bool CheckSubscriptExpr(
|
|
|
94 const evaluate::IndirectSubscriptIntegerExpr &expr) const {
|
|
|
95 return CheckSubscriptExpr(expr.value());
|
|
|
96 }
|
|
|
97 bool CheckSubscriptExpr(
|
|
|
98 const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
|
|
|
99 if (!evaluate::IsConstantExpr(expr)) { // C875,C881
|
|
|
100 context_.Say(
|
|
|
101 source_, "Data object must have constant subscripts"_err_en_US);
|
|
|
102 return false;
|
|
|
103 } else {
|
|
|
104 return true;
|
|
|
105 }
|
|
|
106 }
|
|
|
107
|
|
|
108 SemanticsContext &context_;
|
|
|
109 parser::CharBlock source_;
|
|
|
110 bool hasComponent_{false};
|
|
|
111 bool hasSubscript_{false};
|
|
|
112 };
|
|
|
113
|
|
|
114 // TODO: C876, C877, C879
|
|
|
115 void DataChecker::Leave(const parser::DataIDoObject &object) {
|
|
|
116 if (const auto *designator{
|
|
|
117 std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
|
|
|
118 &object.u)}) {
|
|
|
119 if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
|
|
|
120 auto source{designator->thing.value().source};
|
|
|
121 if (evaluate::IsConstantExpr(*expr)) { // C878
|
|
|
122 exprAnalyzer_.Say(
|
|
|
123 source, "Data implied do object must be a variable"_err_en_US);
|
|
|
124 } else {
|
|
|
125 DataVarChecker checker{exprAnalyzer_.context(), source};
|
|
|
126 if (checker(*expr) && checker.HasComponentWithoutSubscripts()) { // C880
|
|
|
127 exprAnalyzer_.Say(source,
|
|
|
128 "Data implied do structure component must be subscripted"_err_en_US);
|
|
|
129 }
|
|
|
130 }
|
|
|
131 }
|
|
|
132 }
|
|
|
133 }
|
|
|
134
|
|
|
135 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
|
|
|
136 if (const auto *var{
|
|
|
137 std::get_if<common::Indirection<parser::Variable>>(&dataObject.u)}) {
|
|
|
138 if (auto expr{exprAnalyzer_.Analyze(*var)}) {
|
|
|
139 DataVarChecker{exprAnalyzer_.context(),
|
|
|
140 parser::FindSourceLocation(dataObject)}(expr);
|
|
|
141 }
|
|
|
142 }
|
|
|
143 }
|
|
|
144
|
|
|
145 void DataChecker::Leave(const parser::DataStmtRepeat &dataRepeat) {
|
|
|
146 if (const auto *designator{parser::Unwrap<parser::Designator>(dataRepeat)}) {
|
|
|
147 if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
|
|
|
148 if (MaybeExpr checked{exprAnalyzer_.Analyze(*dataRef)}) {
|
|
|
149 auto expr{evaluate::Fold(
|
|
|
150 exprAnalyzer_.GetFoldingContext(), std::move(checked))};
|
|
|
151 if (auto i64{ToInt64(expr)}) {
|
|
|
152 if (*i64 < 0) { // C882
|
|
|
153 exprAnalyzer_.Say(designator->source,
|
|
|
154 "Repeat count for data value must not be negative"_err_en_US);
|
|
|
155 }
|
|
|
156 }
|
|
|
157 }
|
|
|
158 }
|
|
|
159 }
|
|
|
160 }
|
|
|
161 } // namespace Fortran::semantics
|
