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 
11 namespace Fortran::semantics {
12 
13 template <typename T> void DataChecker::CheckIfConstantSubscript(const T &x) {
14   evaluate::ExpressionAnalyzer exprAnalyzer{context_};
15   if (MaybeExpr checked{exprAnalyzer.Analyze(x)}) {
16     if (!evaluate::IsConstantExpr(*checked)) { // C875,C881
17       context_.Say(parser::FindSourceLocation(x),
18           "Data object must have constant bounds"_err_en_US);
19     }
20   }
21 }
22 
23 void DataChecker::CheckSubscript(const parser::SectionSubscript &subscript) {
24   std::visit(common::visitors{
25                  [&](const parser::SubscriptTriplet &triplet) {
26                    CheckIfConstantSubscript(std::get<0>(triplet.t));
27                    CheckIfConstantSubscript(std::get<1>(triplet.t));
28                    CheckIfConstantSubscript(std::get<2>(triplet.t));
29                  },
30                  [&](const parser::IntExpr &intExpr) {
31                    CheckIfConstantSubscript(intExpr);
32                  },
33              },
34       subscript.u);
35 }
36 
37 // Returns false if  DataRef has no subscript
38 bool DataChecker::CheckAllSubscriptsInDataRef(
39     const parser::DataRef &dataRef, parser::CharBlock source) {
40   return std::visit(
41       common::visitors{
42           [&](const parser::Name &) { return false; },
43           [&](const common::Indirection<parser::StructureComponent>
44                   &structureComp) {
45             return CheckAllSubscriptsInDataRef(
46                 structureComp.value().base, source);
47           },
48           [&](const common::Indirection<parser::ArrayElement> &arrayElem) {
49             for (auto &subscript : arrayElem.value().subscripts) {
50               CheckSubscript(subscript);
51             }
52             CheckAllSubscriptsInDataRef(arrayElem.value().base, source);
53             return true;
54           },
55           [&](const common::Indirection<parser::CoindexedNamedObject>
56                   &coindexedObj) { // C874
57             context_.Say(source,
58                 "Data object must not be a coindexed variable"_err_en_US);
59             CheckAllSubscriptsInDataRef(coindexedObj.value().base, source);
60             return true;
61           },
62       },
63       dataRef.u);
64 }
65 
66 void DataChecker::Leave(const parser::DataStmtConstant &dataConst) {
67   if (auto *structure{
68           std::get_if<parser::StructureConstructor>(&dataConst.u)}) {
69     for (const auto &component :
70         std::get<std::list<parser::ComponentSpec>>(structure->t)) {
71       const parser::Expr &parsedExpr{
72           std::get<parser::ComponentDataSource>(component.t).v.value()};
73       if (const auto *expr{GetExpr(parsedExpr)}) {
74         if (!evaluate::IsConstantExpr(*expr)) { // C884
75           context_.Say(parsedExpr.source,
76               "Structure constructor in data value must be a constant expression"_err_en_US);
77         }
78       }
79     }
80   }
81 }
82 
83 // TODO: C876, C877, C879
84 void DataChecker::Leave(const parser::DataImpliedDo &dataImpliedDo) {
85   for (const auto &object :
86       std::get<std::list<parser::DataIDoObject>>(dataImpliedDo.t)) {
87     if (const auto *designator{parser::Unwrap<parser::Designator>(object)}) {
88       if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
89         evaluate::ExpressionAnalyzer exprAnalyzer{context_};
90         if (MaybeExpr checked{exprAnalyzer.Analyze(*dataRef)}) {
91           if (evaluate::IsConstantExpr(*checked)) { // C878
92             context_.Say(designator->source,
93                 "Data implied do object must be a variable"_err_en_US);
94           }
95         }
96         if (!CheckAllSubscriptsInDataRef(*dataRef,
97                 designator->source)) { // C880
98           context_.Say(designator->source,
99               "Data implied do object must be subscripted"_err_en_US);
100         }
101       }
102     }
103   }
104 }
105 
106 void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
107   if (std::get_if<common::Indirection<parser::Variable>>(&dataObject.u)) {
108     if (const auto *designator{
109             parser::Unwrap<parser::Designator>(dataObject)}) {
110       if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
111         CheckAllSubscriptsInDataRef(*dataRef, designator->source);
112       }
113     } else { // C875
114       context_.Say(parser::FindSourceLocation(dataObject),
115           "Data object variable must not be a function reference"_err_en_US);
116     }
117   }
118 }
119 
120 void DataChecker::Leave(const parser::DataStmtRepeat &dataRepeat) {
121   if (const auto *designator{parser::Unwrap<parser::Designator>(dataRepeat)}) {
122     if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
123       evaluate::ExpressionAnalyzer exprAnalyzer{context_};
124       if (MaybeExpr checked{exprAnalyzer.Analyze(*dataRef)}) {
125         auto expr{
126             evaluate::Fold(context_.foldingContext(), std::move(checked))};
127         if (auto i64{ToInt64(expr)}) {
128           if (*i64 < 0) { // C882
129             context_.Say(designator->source,
130                 "Repeat count for data value must not be negative"_err_en_US);
131           }
132         }
133       }
134     }
135   }
136 }
137 } // namespace Fortran::semantics
138