xref: /llvm-project/flang/lib/Evaluate/check-expression.cpp (revision 62b127eef6b37a57a647050b0e123f6ac928215f) 
1 //===-- lib/Evaluate/check-expression.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 "flang/Evaluate/check-expression.h"
10 #include "flang/Evaluate/intrinsics.h"
11 #include "flang/Evaluate/traverse.h"
12 #include "flang/Evaluate/type.h"
13 #include "flang/Semantics/symbol.h"
14 #include "flang/Semantics/tools.h"
15 #include <set>
16 #include <string>
17 
18 namespace Fortran::evaluate {
19 
20 // Constant expression predicate IsConstantExpr().
21 // This code determines whether an expression is a "constant expression"
22 // in the sense of section 10.1.12.  This is not the same thing as being
23 // able to fold it (yet) into a known constant value; specifically,
24 // the expression may reference derived type kind parameters whose values
25 // are not yet known.
26 class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
27 public:
28   using Base = AllTraverse<IsConstantExprHelper, true>;
29   IsConstantExprHelper() : Base{*this} {}
30   using Base::operator();
31 
32   template <int KIND> bool operator()(const TypeParamInquiry<KIND> &inq) const {
33     return IsKindTypeParameter(inq.parameter());
34   }
35   bool operator()(const semantics::Symbol &symbol) const {
36     return IsNamedConstant(symbol) || IsImpliedDoIndex(symbol);
37   }
38   bool operator()(const CoarrayRef &) const { return false; }
39   bool operator()(const semantics::ParamValue &param) const {
40     return param.isExplicit() && (*this)(param.GetExplicit());
41   }
42   template <typename T> bool operator()(const FunctionRef<T> &call) const {
43     if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) {
44       return intrinsic->name == "kind";
45       // TODO: other inquiry intrinsics
46     } else {
47       return false;
48     }
49   }
50   bool operator()(const StructureConstructor &constructor) const {
51     for (const auto &[symRef, expr] : constructor) {
52       if (IsAllocatable(*symRef)) {
53         return IsNullPointer(expr.value());
54       } else if (IsPointer(*symRef)) {
55         return IsNullPointer(expr.value()) || IsInitialDataTarget(expr.value());
56       } else if (!(*this)(expr.value())) {
57         return false;
58       }
59     }
60     return true;
61   }
62   bool operator()(const Component &component) const {
63     return (*this)(component.base());
64   }
65   // Forbid integer division by zero in constants.
66   template <int KIND>
67   bool operator()(
68       const Divide<Type<TypeCategory::Integer, KIND>> &division) const {
69     using T = Type<TypeCategory::Integer, KIND>;
70     if (const auto divisor{GetScalarConstantValue<T>(division.right())}) {
71       return !divisor->IsZero() && (*this)(division.left());
72     } else {
73       return false;
74     }
75   }
76 };
77 
78 template <typename A> bool IsConstantExpr(const A &x) {
79   return IsConstantExprHelper{}(x);
80 }
81 template bool IsConstantExpr(const Expr<SomeType> &);
82 template bool IsConstantExpr(const Expr<SomeInteger> &);
83 template bool IsConstantExpr(const Expr<SubscriptInteger> &);
84 
85 // Object pointer initialization checking predicate IsInitialDataTarget().
86 // This code determines whether an expression is allowable as the static
87 // data address used to initialize a pointer with "=> x".  See C765.
88 // If messages are requested, errors may be generated without returning
89 // a false result.
90 class IsInitialDataTargetHelper
91     : public AllTraverse<IsInitialDataTargetHelper, true> {
92 public:
93   using Base = AllTraverse<IsInitialDataTargetHelper, true>;
94   using Base::operator();
95   explicit IsInitialDataTargetHelper(parser::ContextualMessages *m)
96       : Base{*this}, messages_{m} {}
97 
98   bool operator()(const BOZLiteralConstant &) const { return false; }
99   bool operator()(const NullPointer &) const { return true; }
100   template <typename T> bool operator()(const Constant<T> &) const {
101     return false;
102   }
103   bool operator()(const semantics::Symbol &symbol) const {
104     const Symbol &ultimate{symbol.GetUltimate()};
105     if (IsAllocatable(ultimate)) {
106       if (messages_) {
107         messages_->Say(
108             "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US,
109             ultimate.name());
110       } else {
111         return false;
112       }
113     } else if (ultimate.Corank() > 0) {
114       if (messages_) {
115         messages_->Say(
116             "An initial data target may not be a reference to a coarray '%s'"_err_en_US,
117             ultimate.name());
118       } else {
119         return false;
120       }
121     } else if (!ultimate.attrs().test(semantics::Attr::TARGET)) {
122       if (messages_) {
123         messages_->Say(
124             "An initial data target may not be a reference to an object '%s' that lacks the TARGET attribute"_err_en_US,
125             ultimate.name());
126       } else {
127         return false;
128       }
129     } else if (!IsSaved(ultimate)) {
130       if (messages_) {
131         messages_->Say(
132             "An initial data target may not be a reference to an object '%s' that lacks the SAVE attribute"_err_en_US,
133             ultimate.name());
134       } else {
135         return false;
136       }
137     }
138     return true;
139   }
140   bool operator()(const StaticDataObject &) const { return false; }
141   template <int KIND> bool operator()(const TypeParamInquiry<KIND> &) const {
142     return false;
143   }
144   bool operator()(const Triplet &x) const {
145     return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) &&
146         IsConstantExpr(x.stride());
147   }
148   bool operator()(const Subscript &x) const {
149     return std::visit(common::visitors{
150                           [&](const Triplet &t) { return (*this)(t); },
151                           [&](const auto &y) {
152                             return y.value().Rank() == 0 &&
153                                 IsConstantExpr(y.value());
154                           },
155                       },
156         x.u);
157   }
158   bool operator()(const CoarrayRef &) const { return false; }
159   bool operator()(const Substring &x) const {
160     return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) &&
161         (*this)(x.parent());
162   }
163   bool operator()(const DescriptorInquiry &) const { return false; }
164   template <typename T> bool operator()(const ArrayConstructor<T> &) const {
165     return false;
166   }
167   bool operator()(const StructureConstructor &) const { return false; }
168   template <typename T> bool operator()(const FunctionRef<T> &) {
169     return false;
170   }
171   template <typename D, typename R, typename... O>
172   bool operator()(const Operation<D, R, O...> &) const {
173     return false;
174   }
175   template <typename T> bool operator()(const Parentheses<T> &x) const {
176     return (*this)(x.left());
177   }
178   bool operator()(const Relational<SomeType> &) const { return false; }
179 
180 private:
181   parser::ContextualMessages *messages_;
182 };
183 
184 bool IsInitialDataTarget(
185     const Expr<SomeType> &x, parser::ContextualMessages *messages) {
186   return IsInitialDataTargetHelper{messages}(x);
187 }
188 
189 // Specification expression validation (10.1.11(2), C1010)
190 class CheckSpecificationExprHelper
191     : public AnyTraverse<CheckSpecificationExprHelper,
192           std::optional<std::string>> {
193 public:
194   using Result = std::optional<std::string>;
195   using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
196   explicit CheckSpecificationExprHelper(
197       const semantics::Scope &s, const IntrinsicProcTable &table)
198       : Base{*this}, scope_{s}, table_{table} {}
199   using Base::operator();
200 
201   Result operator()(const ProcedureDesignator &) const {
202     return "dummy procedure argument";
203   }
204   Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
205 
206   Result operator()(const semantics::Symbol &symbol) const {
207     if (semantics::IsNamedConstant(symbol)) {
208       return std::nullopt;
209     } else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754
210       return "derived type component or type parameter value not allowed to "
211              "reference variable '"s +
212           symbol.name().ToString() + "'";
213     } else if (IsDummy(symbol)) {
214       if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
215         return "reference to OPTIONAL dummy argument '"s +
216             symbol.name().ToString() + "'";
217       } else if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) {
218         return "reference to INTENT(OUT) dummy argument '"s +
219             symbol.name().ToString() + "'";
220       } else if (symbol.has<semantics::ObjectEntityDetails>()) {
221         return std::nullopt;
222       } else {
223         return "dummy procedure argument";
224       }
225     } else if (symbol.has<semantics::UseDetails>() ||
226         symbol.has<semantics::HostAssocDetails>() ||
227         symbol.owner().kind() == semantics::Scope::Kind::Module) {
228       return std::nullopt;
229     } else if (const auto *object{
230                    symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
231       // TODO: what about EQUIVALENCE with data in COMMON?
232       // TODO: does this work for blank COMMON?
233       if (object->commonBlock()) {
234         return std::nullopt;
235       }
236     }
237     for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) {
238       s = &s->parent();
239       if (s == &symbol.owner()) {
240         return std::nullopt;
241       }
242     }
243     return "reference to local entity '"s + symbol.name().ToString() + "'";
244   }
245 
246   Result operator()(const Component &x) const {
247     // Don't look at the component symbol.
248     return (*this)(x.base());
249   }
250   Result operator()(const DescriptorInquiry &) const {
251     // Subtle: Uses of SIZE(), LBOUND(), &c. that are valid in specification
252     // expressions will have been converted to expressions over descriptor
253     // inquiries by Fold().
254     return std::nullopt;
255   }
256 
257   template <int KIND>
258   Result operator()(const TypeParamInquiry<KIND> &inq) const {
259     if (scope_.IsDerivedType() && !IsConstantExpr(inq) &&
260         inq.parameter().owner() != scope_) { // C750, C754
261       return "non-constant reference to a type parameter inquiry not "
262              "allowed for derived type components or type parameter values";
263     }
264     return std::nullopt;
265   }
266 
267   template <typename T> Result operator()(const FunctionRef<T> &x) const {
268     if (const auto *symbol{x.proc().GetSymbol()}) {
269       if (!semantics::IsPureProcedure(*symbol)) {
270         return "reference to impure function '"s + symbol->name().ToString() +
271             "'";
272       }
273       if (semantics::IsStmtFunction(*symbol)) {
274         return "reference to statement function '"s +
275             symbol->name().ToString() + "'";
276       }
277       if (scope_.IsDerivedType()) { // C750, C754
278         return "reference to function '"s + symbol->name().ToString() +
279             "' not allowed for derived type components or type parameter"
280             " values";
281       }
282       // TODO: other checks for standard module procedures
283     } else {
284       const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
285       if (scope_.IsDerivedType()) { // C750, C754
286         if ((table_.IsIntrinsic(intrin.name) &&
287                 badIntrinsicsForComponents_.find(intrin.name) !=
288                     badIntrinsicsForComponents_.end()) ||
289             IsProhibitedFunction(intrin.name)) {
290           return "reference to intrinsic '"s + intrin.name +
291               "' not allowed for derived type components or type parameter"
292               " values";
293         }
294         if (table_.GetIntrinsicClass(intrin.name) ==
295                 IntrinsicClass::inquiryFunction &&
296             !IsConstantExpr(x)) {
297           return "non-constant reference to inquiry intrinsic '"s +
298               intrin.name +
299               "' not allowed for derived type components or type"
300               " parameter values";
301         }
302       } else if (intrin.name == "present") {
303         return std::nullopt; // no need to check argument(s)
304       }
305       if (IsConstantExpr(x)) {
306         // inquiry functions may not need to check argument(s)
307         return std::nullopt;
308       }
309     }
310     return (*this)(x.arguments());
311   }
312 
313 private:
314   const semantics::Scope &scope_;
315   const IntrinsicProcTable &table_;
316   const std::set<std::string> badIntrinsicsForComponents_{
317       "allocated", "associated", "extends_type_of", "present", "same_type_as"};
318   static bool IsProhibitedFunction(std::string name) { return false; }
319 };
320 
321 template <typename A>
322 void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages,
323     const semantics::Scope &scope, const IntrinsicProcTable &table) {
324   if (auto why{CheckSpecificationExprHelper{scope, table}(x)}) {
325     messages.Say("Invalid specification expression: %s"_err_en_US, *why);
326   }
327 }
328 
329 template void CheckSpecificationExpr(const Expr<SomeType> &,
330     parser::ContextualMessages &, const semantics::Scope &,
331     const IntrinsicProcTable &);
332 template void CheckSpecificationExpr(const Expr<SomeInteger> &,
333     parser::ContextualMessages &, const semantics::Scope &,
334     const IntrinsicProcTable &);
335 template void CheckSpecificationExpr(const Expr<SubscriptInteger> &,
336     parser::ContextualMessages &, const semantics::Scope &,
337     const IntrinsicProcTable &);
338 template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &,
339     parser::ContextualMessages &, const semantics::Scope &,
340     const IntrinsicProcTable &);
341 template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
342     parser::ContextualMessages &, const semantics::Scope &,
343     const IntrinsicProcTable &);
344 template void CheckSpecificationExpr(
345     const std::optional<Expr<SubscriptInteger>> &, parser::ContextualMessages &,
346     const semantics::Scope &, const IntrinsicProcTable &);
347 
348 // IsSimplyContiguous() -- 9.5.4
349 class IsSimplyContiguousHelper
350     : public AnyTraverse<IsSimplyContiguousHelper, std::optional<bool>> {
351 public:
352   using Result = std::optional<bool>; // tri-state
353   using Base = AnyTraverse<IsSimplyContiguousHelper, Result>;
354   explicit IsSimplyContiguousHelper(const IntrinsicProcTable &t)
355       : Base{*this}, table_{t} {}
356   using Base::operator();
357 
358   Result operator()(const semantics::Symbol &symbol) const {
359     if (symbol.attrs().test(semantics::Attr::CONTIGUOUS) ||
360         symbol.Rank() == 0) {
361       return true;
362     } else if (semantics::IsPointer(symbol)) {
363       return false;
364     } else if (const auto *details{
365                    symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
366       // N.B. ALLOCATABLEs are deferred shape, not assumed, and
367       // are obviously contiguous.
368       return !details->IsAssumedShape() && !details->IsAssumedRank();
369     } else {
370       return false;
371     }
372   }
373 
374   Result operator()(const ArrayRef &x) const {
375     const auto &symbol{x.GetLastSymbol()};
376     if (!(*this)(symbol)) {
377       return false;
378     } else if (auto rank{CheckSubscripts(x.subscript())}) {
379       // a(:)%b(1,1) is not contiguous; a(1)%b(:,:) is
380       return *rank > 0 || x.Rank() == 0;
381     } else {
382       return false;
383     }
384   }
385   Result operator()(const CoarrayRef &x) const {
386     return CheckSubscripts(x.subscript()).has_value();
387   }
388   Result operator()(const Component &x) const {
389     return x.base().Rank() == 0 && (*this)(x.GetLastSymbol());
390   }
391   Result operator()(const ComplexPart &) const { return false; }
392   Result operator()(const Substring &) const { return false; }
393 
394   template <typename T> Result operator()(const FunctionRef<T> &x) const {
395     if (auto chars{
396             characteristics::Procedure::Characterize(x.proc(), table_)}) {
397       if (chars->functionResult) {
398         const auto &result{*chars->functionResult};
399         return !result.IsProcedurePointer() &&
400             result.attrs.test(characteristics::FunctionResult::Attr::Pointer) &&
401             result.attrs.test(
402                 characteristics::FunctionResult::Attr::Contiguous);
403       }
404     }
405     return false;
406   }
407 
408 private:
409   // If the subscripts can possibly be on a simply-contiguous array reference,
410   // return the rank.
411   static std::optional<int> CheckSubscripts(
412       const std::vector<Subscript> &subscript) {
413     bool anyTriplet{false};
414     int rank{0};
415     for (auto j{subscript.size()}; j-- > 0;) {
416       if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
417         if (!triplet->IsStrideOne()) {
418           return std::nullopt;
419         } else if (anyTriplet) {
420           if (triplet->lower() || triplet->upper()) {
421             // all triplets before the last one must be just ":"
422             return std::nullopt;
423           }
424         } else {
425           anyTriplet = true;
426         }
427         ++rank;
428       } else if (anyTriplet || subscript[j].Rank() > 0) {
429         return std::nullopt;
430       }
431     }
432     return rank;
433   }
434 
435   const IntrinsicProcTable &table_;
436 };
437 
438 template <typename A>
439 bool IsSimplyContiguous(const A &x, const IntrinsicProcTable &table) {
440   if (IsVariable(x)) {
441     auto known{IsSimplyContiguousHelper{table}(x)};
442     return known && *known;
443   } else {
444     return true; // not a variable
445   }
446 }
447 
448 template bool IsSimplyContiguous(
449     const Expr<SomeType> &, const IntrinsicProcTable &);
450 
451 } // namespace Fortran::evaluate
452