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/characteristics.h" 11 #include "flang/Evaluate/intrinsics.h" 12 #include "flang/Evaluate/traverse.h" 13 #include "flang/Evaluate/type.h" 14 #include "flang/Semantics/symbol.h" 15 #include "flang/Semantics/tools.h" 16 #include <set> 17 #include <string> 18 19 namespace Fortran::evaluate { 20 21 // Constant expression predicate IsConstantExpr(). 22 // This code determines whether an expression is a "constant expression" 23 // in the sense of section 10.1.12. This is not the same thing as being 24 // able to fold it (yet) into a known constant value; specifically, 25 // the expression may reference derived type kind parameters whose values 26 // are not yet known. 27 class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> { 28 public: 29 using Base = AllTraverse<IsConstantExprHelper, true>; 30 IsConstantExprHelper() : Base{*this} {} 31 using Base::operator(); 32 33 // A missing expression is not considered to be constant. 34 template <typename A> bool operator()(const std::optional<A> &x) const { 35 return x && (*this)(*x); 36 } 37 38 bool operator()(const TypeParamInquiry &inq) const { 39 return semantics::IsKindTypeParameter(inq.parameter()); 40 } 41 bool operator()(const semantics::Symbol &symbol) const { 42 const auto &ultimate{symbol.GetUltimate()}; 43 return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) || 44 IsInitialProcedureTarget(ultimate); 45 } 46 bool operator()(const CoarrayRef &) const { return false; } 47 bool operator()(const semantics::ParamValue ¶m) const { 48 return param.isExplicit() && (*this)(param.GetExplicit()); 49 } 50 bool operator()(const ProcedureRef &) const; 51 bool operator()(const StructureConstructor &constructor) const { 52 for (const auto &[symRef, expr] : constructor) { 53 if (!IsConstantStructureConstructorComponent(*symRef, expr.value())) { 54 return false; 55 } 56 } 57 return true; 58 } 59 bool operator()(const Component &component) const { 60 return (*this)(component.base()); 61 } 62 // Forbid integer division by zero in constants. 63 template <int KIND> 64 bool operator()( 65 const Divide<Type<TypeCategory::Integer, KIND>> &division) const { 66 using T = Type<TypeCategory::Integer, KIND>; 67 if (const auto divisor{GetScalarConstantValue<T>(division.right())}) { 68 return !divisor->IsZero() && (*this)(division.left()); 69 } else { 70 return false; 71 } 72 } 73 74 bool operator()(const Constant<SomeDerived> &) const { return true; } 75 bool operator()(const DescriptorInquiry &) const { return false; } 76 77 private: 78 bool IsConstantStructureConstructorComponent( 79 const Symbol &, const Expr<SomeType> &) const; 80 bool IsConstantExprShape(const Shape &) const; 81 }; 82 83 bool IsConstantExprHelper::IsConstantStructureConstructorComponent( 84 const Symbol &component, const Expr<SomeType> &expr) const { 85 if (IsAllocatable(component)) { 86 return IsNullPointer(expr); 87 } else if (IsPointer(component)) { 88 return IsNullPointer(expr) || IsInitialDataTarget(expr) || 89 IsInitialProcedureTarget(expr); 90 } else { 91 return (*this)(expr); 92 } 93 } 94 95 bool IsConstantExprHelper::operator()(const ProcedureRef &call) const { 96 // LBOUND, UBOUND, and SIZE with DIM= arguments will have been reritten 97 // into DescriptorInquiry operations. 98 if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) { 99 if (intrinsic->name == "kind" || 100 intrinsic->name == IntrinsicProcTable::InvalidName) { 101 // kind is always a constant, and we avoid cascading errors by considering 102 // invalid calls to intrinsics to be constant 103 return true; 104 } else if (intrinsic->name == "lbound" && call.arguments().size() == 1) { 105 // LBOUND(x) without DIM= 106 auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())}; 107 return base && IsConstantExprShape(GetLowerBounds(*base)); 108 } else if (intrinsic->name == "ubound" && call.arguments().size() == 1) { 109 // UBOUND(x) without DIM= 110 auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())}; 111 return base && IsConstantExprShape(GetUpperBounds(*base)); 112 } else if (intrinsic->name == "shape") { 113 auto shape{GetShape(call.arguments()[0]->UnwrapExpr())}; 114 return shape && IsConstantExprShape(*shape); 115 } else if (intrinsic->name == "size" && call.arguments().size() == 1) { 116 // SIZE(x) without DIM 117 auto shape{GetShape(call.arguments()[0]->UnwrapExpr())}; 118 return shape && IsConstantExprShape(*shape); 119 } 120 // TODO: STORAGE_SIZE 121 } 122 return false; 123 } 124 125 bool IsConstantExprHelper::IsConstantExprShape(const Shape &shape) const { 126 for (const auto &extent : shape) { 127 if (!(*this)(extent)) { 128 return false; 129 } 130 } 131 return true; 132 } 133 134 template <typename A> bool IsConstantExpr(const A &x) { 135 return IsConstantExprHelper{}(x); 136 } 137 template bool IsConstantExpr(const Expr<SomeType> &); 138 template bool IsConstantExpr(const Expr<SomeInteger> &); 139 template bool IsConstantExpr(const Expr<SubscriptInteger> &); 140 template bool IsConstantExpr(const StructureConstructor &); 141 142 // IsActuallyConstant() 143 struct IsActuallyConstantHelper { 144 template <typename A> bool operator()(const A &) { return false; } 145 template <typename T> bool operator()(const Constant<T> &) { return true; } 146 template <typename T> bool operator()(const Parentheses<T> &x) { 147 return (*this)(x.left()); 148 } 149 template <typename T> bool operator()(const Expr<T> &x) { 150 return std::visit([=](const auto &y) { return (*this)(y); }, x.u); 151 } 152 template <typename A> bool operator()(const A *x) { return x && (*this)(*x); } 153 template <typename A> bool operator()(const std::optional<A> &x) { 154 return x && (*this)(*x); 155 } 156 }; 157 158 template <typename A> bool IsActuallyConstant(const A &x) { 159 return IsActuallyConstantHelper{}(x); 160 } 161 162 template bool IsActuallyConstant(const Expr<SomeType> &); 163 164 // Object pointer initialization checking predicate IsInitialDataTarget(). 165 // This code determines whether an expression is allowable as the static 166 // data address used to initialize a pointer with "=> x". See C765. 167 class IsInitialDataTargetHelper 168 : public AllTraverse<IsInitialDataTargetHelper, true> { 169 public: 170 using Base = AllTraverse<IsInitialDataTargetHelper, true>; 171 using Base::operator(); 172 explicit IsInitialDataTargetHelper(parser::ContextualMessages *m) 173 : Base{*this}, messages_{m} {} 174 175 bool emittedMessage() const { return emittedMessage_; } 176 177 bool operator()(const BOZLiteralConstant &) const { return false; } 178 bool operator()(const NullPointer &) const { return true; } 179 template <typename T> bool operator()(const Constant<T> &) const { 180 return false; 181 } 182 bool operator()(const semantics::Symbol &symbol) { 183 const Symbol &ultimate{symbol.GetUltimate()}; 184 if (IsAllocatable(ultimate)) { 185 if (messages_) { 186 messages_->Say( 187 "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US, 188 ultimate.name()); 189 emittedMessage_ = true; 190 } 191 return false; 192 } else if (ultimate.Corank() > 0) { 193 if (messages_) { 194 messages_->Say( 195 "An initial data target may not be a reference to a coarray '%s'"_err_en_US, 196 ultimate.name()); 197 emittedMessage_ = true; 198 } 199 return false; 200 } else if (!ultimate.attrs().test(semantics::Attr::TARGET)) { 201 if (messages_) { 202 messages_->Say( 203 "An initial data target may not be a reference to an object '%s' that lacks the TARGET attribute"_err_en_US, 204 ultimate.name()); 205 emittedMessage_ = true; 206 } 207 return false; 208 } else if (!IsSaved(ultimate)) { 209 if (messages_) { 210 messages_->Say( 211 "An initial data target may not be a reference to an object '%s' that lacks the SAVE attribute"_err_en_US, 212 ultimate.name()); 213 emittedMessage_ = true; 214 } 215 return false; 216 } 217 return true; 218 } 219 bool operator()(const StaticDataObject &) const { return false; } 220 bool operator()(const TypeParamInquiry &) const { return false; } 221 bool operator()(const Triplet &x) const { 222 return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) && 223 IsConstantExpr(x.stride()); 224 } 225 bool operator()(const Subscript &x) const { 226 return std::visit(common::visitors{ 227 [&](const Triplet &t) { return (*this)(t); }, 228 [&](const auto &y) { 229 return y.value().Rank() == 0 && 230 IsConstantExpr(y.value()); 231 }, 232 }, 233 x.u); 234 } 235 bool operator()(const CoarrayRef &) const { return false; } 236 bool operator()(const Substring &x) const { 237 return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) && 238 (*this)(x.parent()); 239 } 240 bool operator()(const DescriptorInquiry &) const { return false; } 241 template <typename T> bool operator()(const ArrayConstructor<T> &) const { 242 return false; 243 } 244 bool operator()(const StructureConstructor &) const { return false; } 245 template <typename T> bool operator()(const FunctionRef<T> &) { 246 return false; 247 } 248 template <typename D, typename R, typename... O> 249 bool operator()(const Operation<D, R, O...> &) const { 250 return false; 251 } 252 template <typename T> bool operator()(const Parentheses<T> &x) const { 253 return (*this)(x.left()); 254 } 255 template <typename T> bool operator()(const FunctionRef<T> &x) const { 256 return false; 257 } 258 bool operator()(const Relational<SomeType> &) const { return false; } 259 260 private: 261 parser::ContextualMessages *messages_; 262 bool emittedMessage_{false}; 263 }; 264 265 bool IsInitialDataTarget( 266 const Expr<SomeType> &x, parser::ContextualMessages *messages) { 267 IsInitialDataTargetHelper helper{messages}; 268 bool result{helper(x)}; 269 if (!result && messages && !helper.emittedMessage()) { 270 messages->Say( 271 "An initial data target must be a designator with constant subscripts"_err_en_US); 272 } 273 return result; 274 } 275 276 bool IsInitialProcedureTarget(const semantics::Symbol &symbol) { 277 const auto &ultimate{symbol.GetUltimate()}; 278 return std::visit( 279 common::visitors{ 280 [](const semantics::SubprogramDetails &) { return true; }, 281 [](const semantics::SubprogramNameDetails &) { return true; }, 282 [&](const semantics::ProcEntityDetails &proc) { 283 return !semantics::IsPointer(ultimate) && !proc.isDummy(); 284 }, 285 [](const auto &) { return false; }, 286 }, 287 ultimate.details()); 288 } 289 290 bool IsInitialProcedureTarget(const ProcedureDesignator &proc) { 291 if (const auto *intrin{proc.GetSpecificIntrinsic()}) { 292 return !intrin->isRestrictedSpecific; 293 } else if (proc.GetComponent()) { 294 return false; 295 } else { 296 return IsInitialProcedureTarget(DEREF(proc.GetSymbol())); 297 } 298 } 299 300 bool IsInitialProcedureTarget(const Expr<SomeType> &expr) { 301 if (const auto *proc{std::get_if<ProcedureDesignator>(&expr.u)}) { 302 return IsInitialProcedureTarget(*proc); 303 } else { 304 return IsNullPointer(expr); 305 } 306 } 307 308 class ScalarExpansionVisitor : public AnyTraverse<ScalarExpansionVisitor, 309 std::optional<Expr<SomeType>>> { 310 public: 311 using Result = std::optional<Expr<SomeType>>; 312 using Base = AnyTraverse<ScalarExpansionVisitor, Result>; 313 ScalarExpansionVisitor( 314 ConstantSubscripts &&shape, std::optional<ConstantSubscripts> &&lb) 315 : Base{*this}, shape_{std::move(shape)}, lbounds_{std::move(lb)} {} 316 using Base::operator(); 317 template <typename T> Result operator()(const Constant<T> &x) { 318 auto expanded{x.Reshape(std::move(shape_))}; 319 if (lbounds_) { 320 expanded.set_lbounds(std::move(*lbounds_)); 321 } 322 return AsGenericExpr(std::move(expanded)); 323 } 324 325 private: 326 ConstantSubscripts shape_; 327 std::optional<ConstantSubscripts> lbounds_; 328 }; 329 330 // Converts, folds, and then checks type, rank, and shape of an 331 // initialization expression for a named constant, a non-pointer 332 // variable static initializatio, a component default initializer, 333 // a type parameter default value, or instantiated type parameter value. 334 std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol, 335 Expr<SomeType> &&x, FoldingContext &context, 336 const semantics::Scope *instantiation) { 337 CHECK(!IsPointer(symbol)); 338 if (auto symTS{ 339 characteristics::TypeAndShape::Characterize(symbol, context)}) { 340 auto xType{x.GetType()}; 341 if (auto converted{ConvertToType(symTS->type(), std::move(x))}) { 342 auto folded{Fold(context, std::move(*converted))}; 343 if (IsActuallyConstant(folded)) { 344 int symRank{GetRank(symTS->shape())}; 345 if (IsImpliedShape(symbol)) { 346 if (folded.Rank() == symRank) { 347 return {std::move(folded)}; 348 } else { 349 context.messages().Say( 350 "Implied-shape parameter '%s' has rank %d but its initializer has rank %d"_err_en_US, 351 symbol.name(), symRank, folded.Rank()); 352 } 353 } else if (auto extents{AsConstantExtents(context, symTS->shape())}) { 354 if (folded.Rank() == 0 && symRank > 0) { 355 return ScalarConstantExpander{std::move(*extents), 356 AsConstantExtents( 357 context, GetLowerBounds(context, NamedEntity{symbol}))} 358 .Expand(std::move(folded)); 359 } else if (auto resultShape{GetShape(context, folded)}) { 360 if (CheckConformance(context.messages(), symTS->shape(), 361 *resultShape, "initialized object", 362 "initialization expression", false, false)) { 363 return {std::move(folded)}; 364 } 365 } 366 } else if (IsNamedConstant(symbol)) { 367 if (IsExplicitShape(symbol)) { 368 context.messages().Say( 369 "Named constant '%s' array must have constant shape"_err_en_US, 370 symbol.name()); 371 } else { 372 // Declaration checking handles other cases 373 } 374 } else { 375 context.messages().Say( 376 "Shape of initialized object '%s' must be constant"_err_en_US, 377 symbol.name()); 378 } 379 } else if (IsErrorExpr(folded)) { 380 } else if (IsLenTypeParameter(symbol)) { 381 return {std::move(folded)}; 382 } else if (IsKindTypeParameter(symbol)) { 383 if (instantiation) { 384 context.messages().Say( 385 "Value of kind type parameter '%s' (%s) must be a scalar INTEGER constant"_err_en_US, 386 symbol.name(), folded.AsFortran()); 387 } else { 388 return {std::move(folded)}; 389 } 390 } else if (IsNamedConstant(symbol)) { 391 context.messages().Say( 392 "Value of named constant '%s' (%s) cannot be computed as a constant value"_err_en_US, 393 symbol.name(), folded.AsFortran()); 394 } else { 395 context.messages().Say( 396 "Initialization expression for '%s' (%s) cannot be computed as a constant value"_err_en_US, 397 symbol.name(), folded.AsFortran()); 398 } 399 } else if (xType) { 400 context.messages().Say( 401 "Initialization expression cannot be converted to declared type of '%s' from %s"_err_en_US, 402 symbol.name(), xType->AsFortran()); 403 } else { 404 context.messages().Say( 405 "Initialization expression cannot be converted to declared type of '%s'"_err_en_US, 406 symbol.name()); 407 } 408 } 409 return std::nullopt; 410 } 411 412 // Specification expression validation (10.1.11(2), C1010) 413 class CheckSpecificationExprHelper 414 : public AnyTraverse<CheckSpecificationExprHelper, 415 std::optional<std::string>> { 416 public: 417 using Result = std::optional<std::string>; 418 using Base = AnyTraverse<CheckSpecificationExprHelper, Result>; 419 explicit CheckSpecificationExprHelper( 420 const semantics::Scope &s, FoldingContext &context) 421 : Base{*this}, scope_{s}, context_{context} {} 422 using Base::operator(); 423 424 Result operator()(const ProcedureDesignator &) const { 425 return "dummy procedure argument"; 426 } 427 Result operator()(const CoarrayRef &) const { return "coindexed reference"; } 428 429 Result operator()(const semantics::Symbol &symbol) const { 430 const auto &ultimate{symbol.GetUltimate()}; 431 if (semantics::IsNamedConstant(ultimate) || ultimate.owner().IsModule() || 432 ultimate.owner().IsSubmodule()) { 433 return std::nullopt; 434 } else if (scope_.IsDerivedType() && 435 IsVariableName(ultimate)) { // C750, C754 436 return "derived type component or type parameter value not allowed to " 437 "reference variable '"s + 438 ultimate.name().ToString() + "'"; 439 } else if (IsDummy(ultimate)) { 440 if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) { 441 return "reference to OPTIONAL dummy argument '"s + 442 ultimate.name().ToString() + "'"; 443 } else if (ultimate.attrs().test(semantics::Attr::INTENT_OUT)) { 444 return "reference to INTENT(OUT) dummy argument '"s + 445 ultimate.name().ToString() + "'"; 446 } else if (ultimate.has<semantics::ObjectEntityDetails>()) { 447 return std::nullopt; 448 } else { 449 return "dummy procedure argument"; 450 } 451 } else if (const auto *object{ 452 ultimate.detailsIf<semantics::ObjectEntityDetails>()}) { 453 if (object->commonBlock()) { 454 return std::nullopt; 455 } 456 } 457 for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) { 458 s = &s->parent(); 459 if (s == &ultimate.owner()) { 460 return std::nullopt; 461 } 462 } 463 return "reference to local entity '"s + ultimate.name().ToString() + "'"; 464 } 465 466 Result operator()(const Component &x) const { 467 // Don't look at the component symbol. 468 return (*this)(x.base()); 469 } 470 Result operator()(const DescriptorInquiry &) const { 471 // Subtle: Uses of SIZE(), LBOUND(), &c. that are valid in specification 472 // expressions will have been converted to expressions over descriptor 473 // inquiries by Fold(). 474 return std::nullopt; 475 } 476 477 Result operator()(const TypeParamInquiry &inq) const { 478 if (scope_.IsDerivedType() && !IsConstantExpr(inq) && 479 inq.base() /* X%T, not local T */) { // C750, C754 480 return "non-constant reference to a type parameter inquiry not " 481 "allowed for derived type components or type parameter values"; 482 } 483 return std::nullopt; 484 } 485 486 template <typename T> Result operator()(const FunctionRef<T> &x) const { 487 if (const auto *symbol{x.proc().GetSymbol()}) { 488 const Symbol &ultimate{symbol->GetUltimate()}; 489 if (!semantics::IsPureProcedure(ultimate)) { 490 return "reference to impure function '"s + ultimate.name().ToString() + 491 "'"; 492 } 493 if (semantics::IsStmtFunction(ultimate)) { 494 return "reference to statement function '"s + 495 ultimate.name().ToString() + "'"; 496 } 497 if (scope_.IsDerivedType()) { // C750, C754 498 return "reference to function '"s + ultimate.name().ToString() + 499 "' not allowed for derived type components or type parameter" 500 " values"; 501 } 502 // TODO: other checks for standard module procedures 503 } else { 504 const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())}; 505 if (scope_.IsDerivedType()) { // C750, C754 506 if ((context_.intrinsics().IsIntrinsic(intrin.name) && 507 badIntrinsicsForComponents_.find(intrin.name) != 508 badIntrinsicsForComponents_.end()) || 509 IsProhibitedFunction(intrin.name)) { 510 return "reference to intrinsic '"s + intrin.name + 511 "' not allowed for derived type components or type parameter" 512 " values"; 513 } 514 if (context_.intrinsics().GetIntrinsicClass(intrin.name) == 515 IntrinsicClass::inquiryFunction && 516 !IsConstantExpr(x)) { 517 return "non-constant reference to inquiry intrinsic '"s + 518 intrin.name + 519 "' not allowed for derived type components or type" 520 " parameter values"; 521 } 522 } else if (intrin.name == "present") { 523 return std::nullopt; // no need to check argument(s) 524 } 525 if (IsConstantExpr(x)) { 526 // inquiry functions may not need to check argument(s) 527 return std::nullopt; 528 } 529 } 530 return (*this)(x.arguments()); 531 } 532 533 private: 534 const semantics::Scope &scope_; 535 FoldingContext &context_; 536 const std::set<std::string> badIntrinsicsForComponents_{ 537 "allocated", "associated", "extends_type_of", "present", "same_type_as"}; 538 static bool IsProhibitedFunction(std::string name) { return false; } 539 }; 540 541 template <typename A> 542 void CheckSpecificationExpr( 543 const A &x, const semantics::Scope &scope, FoldingContext &context) { 544 if (auto why{CheckSpecificationExprHelper{scope, context}(x)}) { 545 context.messages().Say( 546 "Invalid specification expression: %s"_err_en_US, *why); 547 } 548 } 549 550 template void CheckSpecificationExpr( 551 const Expr<SomeType> &, const semantics::Scope &, FoldingContext &); 552 template void CheckSpecificationExpr( 553 const Expr<SomeInteger> &, const semantics::Scope &, FoldingContext &); 554 template void CheckSpecificationExpr( 555 const Expr<SubscriptInteger> &, const semantics::Scope &, FoldingContext &); 556 template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &, 557 const semantics::Scope &, FoldingContext &); 558 template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &, 559 const semantics::Scope &, FoldingContext &); 560 template void CheckSpecificationExpr( 561 const std::optional<Expr<SubscriptInteger>> &, const semantics::Scope &, 562 FoldingContext &); 563 564 // IsSimplyContiguous() -- 9.5.4 565 class IsSimplyContiguousHelper 566 : public AnyTraverse<IsSimplyContiguousHelper, std::optional<bool>> { 567 public: 568 using Result = std::optional<bool>; // tri-state 569 using Base = AnyTraverse<IsSimplyContiguousHelper, Result>; 570 explicit IsSimplyContiguousHelper(FoldingContext &c) 571 : Base{*this}, context_{c} {} 572 using Base::operator(); 573 574 Result operator()(const semantics::Symbol &symbol) const { 575 if (symbol.attrs().test(semantics::Attr::CONTIGUOUS) || 576 symbol.Rank() == 0) { 577 return true; 578 } else if (semantics::IsPointer(symbol)) { 579 return false; 580 } else if (const auto *details{ 581 symbol.detailsIf<semantics::ObjectEntityDetails>()}) { 582 // N.B. ALLOCATABLEs are deferred shape, not assumed, and 583 // are obviously contiguous. 584 return !details->IsAssumedShape() && !details->IsAssumedRank(); 585 } else { 586 return false; 587 } 588 } 589 590 Result operator()(const ArrayRef &x) const { 591 const auto &symbol{x.GetLastSymbol()}; 592 if (!(*this)(symbol)) { 593 return false; 594 } else if (auto rank{CheckSubscripts(x.subscript())}) { 595 // a(:)%b(1,1) is not contiguous; a(1)%b(:,:) is 596 return *rank > 0 || x.Rank() == 0; 597 } else { 598 return false; 599 } 600 } 601 Result operator()(const CoarrayRef &x) const { 602 return CheckSubscripts(x.subscript()).has_value(); 603 } 604 Result operator()(const Component &x) const { 605 return x.base().Rank() == 0 && (*this)(x.GetLastSymbol()); 606 } 607 Result operator()(const ComplexPart &) const { return false; } 608 Result operator()(const Substring &) const { return false; } 609 610 template <typename T> Result operator()(const FunctionRef<T> &x) const { 611 if (auto chars{ 612 characteristics::Procedure::Characterize(x.proc(), context_)}) { 613 if (chars->functionResult) { 614 const auto &result{*chars->functionResult}; 615 return !result.IsProcedurePointer() && 616 result.attrs.test(characteristics::FunctionResult::Attr::Pointer) && 617 result.attrs.test( 618 characteristics::FunctionResult::Attr::Contiguous); 619 } 620 } 621 return false; 622 } 623 624 private: 625 // If the subscripts can possibly be on a simply-contiguous array reference, 626 // return the rank. 627 static std::optional<int> CheckSubscripts( 628 const std::vector<Subscript> &subscript) { 629 bool anyTriplet{false}; 630 int rank{0}; 631 for (auto j{subscript.size()}; j-- > 0;) { 632 if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) { 633 if (!triplet->IsStrideOne()) { 634 return std::nullopt; 635 } else if (anyTriplet) { 636 if (triplet->lower() || triplet->upper()) { 637 // all triplets before the last one must be just ":" 638 return std::nullopt; 639 } 640 } else { 641 anyTriplet = true; 642 } 643 ++rank; 644 } else if (anyTriplet || subscript[j].Rank() > 0) { 645 return std::nullopt; 646 } 647 } 648 return rank; 649 } 650 651 FoldingContext &context_; 652 }; 653 654 template <typename A> 655 bool IsSimplyContiguous(const A &x, FoldingContext &context) { 656 if (IsVariable(x)) { 657 auto known{IsSimplyContiguousHelper{context}(x)}; 658 return known && *known; 659 } else { 660 return true; // not a variable 661 } 662 } 663 664 template bool IsSimplyContiguous(const Expr<SomeType> &, FoldingContext &); 665 666 // IsErrorExpr() 667 struct IsErrorExprHelper : public AnyTraverse<IsErrorExprHelper, bool> { 668 using Result = bool; 669 using Base = AnyTraverse<IsErrorExprHelper, Result>; 670 IsErrorExprHelper() : Base{*this} {} 671 using Base::operator(); 672 673 bool operator()(const SpecificIntrinsic &x) { 674 return x.name == IntrinsicProcTable::InvalidName; 675 } 676 }; 677 678 template <typename A> bool IsErrorExpr(const A &x) { 679 return IsErrorExprHelper{}(x); 680 } 681 682 template bool IsErrorExpr(const Expr<SomeType> &); 683 684 } // namespace Fortran::evaluate 685