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