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/tools.h" 13 #include "flang/Evaluate/traverse.h" 14 #include "flang/Evaluate/type.h" 15 #include "flang/Semantics/semantics.h" 16 #include "flang/Semantics/symbol.h" 17 #include "flang/Semantics/tools.h" 18 #include <set> 19 #include <string> 20 21 namespace Fortran::evaluate { 22 23 // Constant expression predicates IsConstantExpr() & IsScopeInvariantExpr(). 24 // This code determines whether an expression is a "constant expression" 25 // in the sense of section 10.1.12. This is not the same thing as being 26 // able to fold it (yet) into a known constant value; specifically, 27 // the expression may reference derived type kind parameters whose values 28 // are not yet known. 29 // 30 // The variant form (IsScopeInvariantExpr()) also accepts symbols that are 31 // INTENT(IN) dummy arguments without the VALUE attribute. 32 template <bool INVARIANT> 33 class IsConstantExprHelper 34 : public AllTraverse<IsConstantExprHelper<INVARIANT>, true> { 35 public: 36 using Base = AllTraverse<IsConstantExprHelper, true>; 37 IsConstantExprHelper() : Base{*this} {} 38 using Base::operator(); 39 40 // A missing expression is not considered to be constant. 41 template <typename A> bool operator()(const std::optional<A> &x) const { 42 return x && (*this)(*x); 43 } 44 45 bool operator()(const TypeParamInquiry &inq) const { 46 return INVARIANT || semantics::IsKindTypeParameter(inq.parameter()); 47 } 48 bool operator()(const semantics::Symbol &symbol) const { 49 const auto &ultimate{GetAssociationRoot(symbol)}; 50 return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) || 51 IsInitialProcedureTarget(ultimate) || 52 ultimate.has<semantics::TypeParamDetails>() || 53 (INVARIANT && IsIntentIn(symbol) && !IsOptional(symbol) && 54 !symbol.attrs().test(semantics::Attr::VALUE)); 55 } 56 bool operator()(const CoarrayRef &) const { return false; } 57 bool operator()(const semantics::ParamValue ¶m) const { 58 return param.isExplicit() && (*this)(param.GetExplicit()); 59 } 60 bool operator()(const ProcedureRef &) const; 61 bool operator()(const StructureConstructor &constructor) const { 62 for (const auto &[symRef, expr] : constructor) { 63 if (!IsConstantStructureConstructorComponent(*symRef, expr.value())) { 64 return false; 65 } 66 } 67 return true; 68 } 69 bool operator()(const Component &component) const { 70 return (*this)(component.base()); 71 } 72 // Forbid integer division by zero in constants. 73 template <int KIND> 74 bool operator()( 75 const Divide<Type<TypeCategory::Integer, KIND>> &division) const { 76 using T = Type<TypeCategory::Integer, KIND>; 77 if (const auto divisor{GetScalarConstantValue<T>(division.right())}) { 78 return !divisor->IsZero() && (*this)(division.left()); 79 } else { 80 return false; 81 } 82 } 83 84 bool operator()(const Constant<SomeDerived> &) const { return true; } 85 bool operator()(const DescriptorInquiry &x) const { 86 const Symbol &sym{x.base().GetLastSymbol()}; 87 return INVARIANT && !IsAllocatable(sym) && 88 (!IsDummy(sym) || 89 (IsIntentIn(sym) && !IsOptional(sym) && 90 !sym.attrs().test(semantics::Attr::VALUE))); 91 } 92 93 private: 94 bool IsConstantStructureConstructorComponent( 95 const Symbol &, const Expr<SomeType> &) const; 96 bool IsConstantExprShape(const Shape &) const; 97 }; 98 99 template <bool INVARIANT> 100 bool IsConstantExprHelper<INVARIANT>::IsConstantStructureConstructorComponent( 101 const Symbol &component, const Expr<SomeType> &expr) const { 102 if (IsAllocatable(component)) { 103 return IsNullObjectPointer(expr); 104 } else if (IsPointer(component)) { 105 return IsNullPointer(expr) || IsInitialDataTarget(expr) || 106 IsInitialProcedureTarget(expr); 107 } else { 108 return (*this)(expr); 109 } 110 } 111 112 template <bool INVARIANT> 113 bool IsConstantExprHelper<INVARIANT>::operator()( 114 const ProcedureRef &call) const { 115 // LBOUND, UBOUND, and SIZE with truly constant DIM= arguments will have 116 // been rewritten into DescriptorInquiry operations. 117 if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) { 118 const characteristics::Procedure &proc{intrinsic->characteristics.value()}; 119 if (intrinsic->name == "kind" || 120 intrinsic->name == IntrinsicProcTable::InvalidName || 121 call.arguments().empty() || !call.arguments()[0]) { 122 // kind is always a constant, and we avoid cascading errors by considering 123 // invalid calls to intrinsics to be constant 124 return true; 125 } else if (intrinsic->name == "lbound") { 126 auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())}; 127 return base && IsConstantExprShape(GetLBOUNDs(*base)); 128 } else if (intrinsic->name == "ubound") { 129 auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())}; 130 return base && IsConstantExprShape(GetUBOUNDs(*base)); 131 } else if (intrinsic->name == "shape" || intrinsic->name == "size") { 132 auto shape{GetShape(call.arguments()[0]->UnwrapExpr())}; 133 return shape && IsConstantExprShape(*shape); 134 } else if (proc.IsPure()) { 135 for (const auto &arg : call.arguments()) { 136 if (!arg) { 137 return false; 138 } else if (const auto *expr{arg->UnwrapExpr()}; 139 !expr || !(*this)(*expr)) { 140 return false; 141 } 142 } 143 return true; 144 } 145 // TODO: STORAGE_SIZE 146 } 147 return false; 148 } 149 150 template <bool INVARIANT> 151 bool IsConstantExprHelper<INVARIANT>::IsConstantExprShape( 152 const Shape &shape) const { 153 for (const auto &extent : shape) { 154 if (!(*this)(extent)) { 155 return false; 156 } 157 } 158 return true; 159 } 160 161 template <typename A> bool IsConstantExpr(const A &x) { 162 return IsConstantExprHelper<false>{}(x); 163 } 164 template bool IsConstantExpr(const Expr<SomeType> &); 165 template bool IsConstantExpr(const Expr<SomeInteger> &); 166 template bool IsConstantExpr(const Expr<SubscriptInteger> &); 167 template bool IsConstantExpr(const StructureConstructor &); 168 169 // IsScopeInvariantExpr() 170 template <typename A> bool IsScopeInvariantExpr(const A &x) { 171 return IsConstantExprHelper<true>{}(x); 172 } 173 template bool IsScopeInvariantExpr(const Expr<SomeType> &); 174 template bool IsScopeInvariantExpr(const Expr<SomeInteger> &); 175 template bool IsScopeInvariantExpr(const Expr<SubscriptInteger> &); 176 177 // IsActuallyConstant() 178 struct IsActuallyConstantHelper { 179 template <typename A> bool operator()(const A &) { return false; } 180 template <typename T> bool operator()(const Constant<T> &) { return true; } 181 template <typename T> bool operator()(const Parentheses<T> &x) { 182 return (*this)(x.left()); 183 } 184 template <typename T> bool operator()(const Expr<T> &x) { 185 return common::visit([=](const auto &y) { return (*this)(y); }, x.u); 186 } 187 bool operator()(const Expr<SomeType> &x) { 188 return common::visit([this](const auto &y) { return (*this)(y); }, x.u); 189 } 190 bool operator()(const StructureConstructor &x) { 191 for (const auto &pair : x) { 192 const Expr<SomeType> &y{pair.second.value()}; 193 const auto sym{pair.first}; 194 const bool compIsConstant{(*this)(y)}; 195 // If an allocatable component is initialized by a constant, 196 // the structure constructor is not a constant. 197 if ((!compIsConstant && !IsNullPointer(y)) || 198 (compIsConstant && IsAllocatable(sym))) { 199 return false; 200 } 201 } 202 return true; 203 } 204 template <typename A> bool operator()(const A *x) { return x && (*this)(*x); } 205 template <typename A> bool operator()(const std::optional<A> &x) { 206 return x && (*this)(*x); 207 } 208 }; 209 210 template <typename A> bool IsActuallyConstant(const A &x) { 211 return IsActuallyConstantHelper{}(x); 212 } 213 214 template bool IsActuallyConstant(const Expr<SomeType> &); 215 template bool IsActuallyConstant(const Expr<SomeInteger> &); 216 template bool IsActuallyConstant(const Expr<SubscriptInteger> &); 217 template bool IsActuallyConstant(const std::optional<Expr<SubscriptInteger>> &); 218 219 // Object pointer initialization checking predicate IsInitialDataTarget(). 220 // This code determines whether an expression is allowable as the static 221 // data address used to initialize a pointer with "=> x". See C765. 222 class IsInitialDataTargetHelper 223 : public AllTraverse<IsInitialDataTargetHelper, true> { 224 public: 225 using Base = AllTraverse<IsInitialDataTargetHelper, true>; 226 using Base::operator(); 227 explicit IsInitialDataTargetHelper(parser::ContextualMessages *m) 228 : Base{*this}, messages_{m} {} 229 230 bool emittedMessage() const { return emittedMessage_; } 231 232 bool operator()(const BOZLiteralConstant &) const { return false; } 233 bool operator()(const NullPointer &) const { return true; } 234 template <typename T> bool operator()(const Constant<T> &) const { 235 return false; 236 } 237 bool operator()(const semantics::Symbol &symbol) { 238 // This function checks only base symbols, not components. 239 const Symbol &ultimate{symbol.GetUltimate()}; 240 if (const auto *assoc{ 241 ultimate.detailsIf<semantics::AssocEntityDetails>()}) { 242 if (const auto &expr{assoc->expr()}) { 243 if (IsVariable(*expr)) { 244 return (*this)(*expr); 245 } else if (messages_) { 246 messages_->Say( 247 "An initial data target may not be an associated expression ('%s')"_err_en_US, 248 ultimate.name()); 249 emittedMessage_ = true; 250 } 251 } 252 return false; 253 } else if (!CheckVarOrComponent(ultimate)) { 254 return false; 255 } else if (!ultimate.attrs().test(semantics::Attr::TARGET)) { 256 if (messages_) { 257 messages_->Say( 258 "An initial data target may not be a reference to an object '%s' that lacks the TARGET attribute"_err_en_US, 259 ultimate.name()); 260 emittedMessage_ = true; 261 } 262 return false; 263 } else if (!IsSaved(ultimate)) { 264 if (messages_) { 265 messages_->Say( 266 "An initial data target may not be a reference to an object '%s' that lacks the SAVE attribute"_err_en_US, 267 ultimate.name()); 268 emittedMessage_ = true; 269 } 270 return false; 271 } else { 272 return true; 273 } 274 } 275 bool operator()(const StaticDataObject &) const { return false; } 276 bool operator()(const TypeParamInquiry &) const { return false; } 277 bool operator()(const Triplet &x) const { 278 return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) && 279 IsConstantExpr(x.stride()); 280 } 281 bool operator()(const Subscript &x) const { 282 return common::visit(common::visitors{ 283 [&](const Triplet &t) { return (*this)(t); }, 284 [&](const auto &y) { 285 return y.value().Rank() == 0 && 286 IsConstantExpr(y.value()); 287 }, 288 }, 289 x.u); 290 } 291 bool operator()(const CoarrayRef &) const { return false; } 292 bool operator()(const Component &x) { 293 return CheckVarOrComponent(x.GetLastSymbol()) && (*this)(x.base()); 294 } 295 bool operator()(const Substring &x) const { 296 return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) && 297 (*this)(x.parent()); 298 } 299 bool operator()(const DescriptorInquiry &) const { return false; } 300 template <typename T> bool operator()(const ArrayConstructor<T> &) const { 301 return false; 302 } 303 bool operator()(const StructureConstructor &) const { return false; } 304 template <typename D, typename R, typename... O> 305 bool operator()(const Operation<D, R, O...> &) const { 306 return false; 307 } 308 template <typename T> bool operator()(const Parentheses<T> &x) const { 309 return (*this)(x.left()); 310 } 311 bool operator()(const ProcedureRef &x) const { 312 if (const SpecificIntrinsic * intrinsic{x.proc().GetSpecificIntrinsic()}) { 313 return intrinsic->characteristics.value().attrs.test( 314 characteristics::Procedure::Attr::NullPointer); 315 } 316 return false; 317 } 318 bool operator()(const Relational<SomeType> &) const { return false; } 319 320 private: 321 bool CheckVarOrComponent(const semantics::Symbol &symbol) { 322 const Symbol &ultimate{symbol.GetUltimate()}; 323 const char *unacceptable{nullptr}; 324 if (ultimate.Corank() > 0) { 325 unacceptable = "a coarray"; 326 } else if (IsAllocatable(ultimate)) { 327 unacceptable = "an ALLOCATABLE"; 328 } else if (IsPointer(ultimate)) { 329 unacceptable = "a POINTER"; 330 } else { 331 return true; 332 } 333 if (messages_) { 334 messages_->Say( 335 "An initial data target may not be a reference to %s '%s'"_err_en_US, 336 unacceptable, ultimate.name()); 337 emittedMessage_ = true; 338 } 339 return false; 340 } 341 342 parser::ContextualMessages *messages_; 343 bool emittedMessage_{false}; 344 }; 345 346 bool IsInitialDataTarget( 347 const Expr<SomeType> &x, parser::ContextualMessages *messages) { 348 IsInitialDataTargetHelper helper{messages}; 349 bool result{helper(x)}; 350 if (!result && messages && !helper.emittedMessage()) { 351 messages->Say( 352 "An initial data target must be a designator with constant subscripts"_err_en_US); 353 } 354 return result; 355 } 356 357 bool IsInitialProcedureTarget(const semantics::Symbol &symbol) { 358 const auto &ultimate{symbol.GetUltimate()}; 359 return common::visit( 360 common::visitors{ 361 [&](const semantics::SubprogramDetails &subp) { 362 return !subp.isDummy() && !subp.stmtFunction() && 363 symbol.owner().kind() != semantics::Scope::Kind::MainProgram && 364 symbol.owner().kind() != semantics::Scope::Kind::Subprogram; 365 }, 366 [](const semantics::SubprogramNameDetails &x) { 367 return x.kind() != semantics::SubprogramKind::Internal; 368 }, 369 [&](const semantics::ProcEntityDetails &proc) { 370 return !semantics::IsPointer(ultimate) && !proc.isDummy(); 371 }, 372 [](const auto &) { return false; }, 373 }, 374 ultimate.details()); 375 } 376 377 bool IsInitialProcedureTarget(const ProcedureDesignator &proc) { 378 if (const auto *intrin{proc.GetSpecificIntrinsic()}) { 379 return !intrin->isRestrictedSpecific; 380 } else if (proc.GetComponent()) { 381 return false; 382 } else { 383 return IsInitialProcedureTarget(DEREF(proc.GetSymbol())); 384 } 385 } 386 387 bool IsInitialProcedureTarget(const Expr<SomeType> &expr) { 388 if (const auto *proc{std::get_if<ProcedureDesignator>(&expr.u)}) { 389 return IsInitialProcedureTarget(*proc); 390 } else { 391 return IsNullProcedurePointer(expr); 392 } 393 } 394 395 // Converts, folds, and then checks type, rank, and shape of an 396 // initialization expression for a named constant, a non-pointer 397 // variable static initialization, a component default initializer, 398 // a type parameter default value, or instantiated type parameter value. 399 std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol, 400 Expr<SomeType> &&x, FoldingContext &context, 401 const semantics::Scope *instantiation) { 402 CHECK(!IsPointer(symbol)); 403 if (auto symTS{ 404 characteristics::TypeAndShape::Characterize(symbol, context)}) { 405 auto xType{x.GetType()}; 406 auto converted{ConvertToType(symTS->type(), Expr<SomeType>{x})}; 407 if (!converted && 408 symbol.owner().context().IsEnabled( 409 common::LanguageFeature::LogicalIntegerAssignment)) { 410 converted = DataConstantConversionExtension(context, symTS->type(), x); 411 if (converted && 412 symbol.owner().context().ShouldWarn( 413 common::LanguageFeature::LogicalIntegerAssignment)) { 414 context.messages().Say( 415 "nonstandard usage: initialization of %s with %s"_port_en_US, 416 symTS->type().AsFortran(), x.GetType().value().AsFortran()); 417 } 418 } 419 if (converted) { 420 auto folded{Fold(context, std::move(*converted))}; 421 if (IsActuallyConstant(folded)) { 422 int symRank{GetRank(symTS->shape())}; 423 if (IsImpliedShape(symbol)) { 424 if (folded.Rank() == symRank) { 425 return ArrayConstantBoundChanger{ 426 std::move(*AsConstantExtents( 427 context, GetRawLowerBounds(context, NamedEntity{symbol})))} 428 .ChangeLbounds(std::move(folded)); 429 } else { 430 context.messages().Say( 431 "Implied-shape parameter '%s' has rank %d but its initializer has rank %d"_err_en_US, 432 symbol.name(), symRank, folded.Rank()); 433 } 434 } else if (auto extents{AsConstantExtents(context, symTS->shape())}) { 435 if (folded.Rank() == 0 && symRank == 0) { 436 // symbol and constant are both scalars 437 return {std::move(folded)}; 438 } else if (folded.Rank() == 0 && symRank > 0) { 439 // expand the scalar constant to an array 440 return ScalarConstantExpander{std::move(*extents), 441 AsConstantExtents( 442 context, GetRawLowerBounds(context, NamedEntity{symbol}))} 443 .Expand(std::move(folded)); 444 } else if (auto resultShape{GetShape(context, folded)}) { 445 if (CheckConformance(context.messages(), symTS->shape(), 446 *resultShape, CheckConformanceFlags::None, 447 "initialized object", "initialization expression") 448 .value_or(false /*fail if not known now to conform*/)) { 449 // make a constant array with adjusted lower bounds 450 return ArrayConstantBoundChanger{ 451 std::move(*AsConstantExtents(context, 452 GetRawLowerBounds(context, NamedEntity{symbol})))} 453 .ChangeLbounds(std::move(folded)); 454 } 455 } 456 } else if (IsNamedConstant(symbol)) { 457 if (IsExplicitShape(symbol)) { 458 context.messages().Say( 459 "Named constant '%s' array must have constant shape"_err_en_US, 460 symbol.name()); 461 } else { 462 // Declaration checking handles other cases 463 } 464 } else { 465 context.messages().Say( 466 "Shape of initialized object '%s' must be constant"_err_en_US, 467 symbol.name()); 468 } 469 } else if (IsErrorExpr(folded)) { 470 } else if (IsLenTypeParameter(symbol)) { 471 return {std::move(folded)}; 472 } else if (IsKindTypeParameter(symbol)) { 473 if (instantiation) { 474 context.messages().Say( 475 "Value of kind type parameter '%s' (%s) must be a scalar INTEGER constant"_err_en_US, 476 symbol.name(), folded.AsFortran()); 477 } else { 478 return {std::move(folded)}; 479 } 480 } else if (IsNamedConstant(symbol)) { 481 if (symbol.name() == "numeric_storage_size" && 482 symbol.owner().IsModule() && 483 DEREF(symbol.owner().symbol()).name() == "iso_fortran_env") { 484 // Very special case: numeric_storage_size is not folded until 485 // it read from the iso_fortran_env module file, as its value 486 // depends on compilation options. 487 return {std::move(folded)}; 488 } 489 context.messages().Say( 490 "Value of named constant '%s' (%s) cannot be computed as a constant value"_err_en_US, 491 symbol.name(), folded.AsFortran()); 492 } else { 493 context.messages().Say( 494 "Initialization expression for '%s' (%s) cannot be computed as a constant value"_err_en_US, 495 symbol.name(), folded.AsFortran()); 496 } 497 } else if (xType) { 498 context.messages().Say( 499 "Initialization expression cannot be converted to declared type of '%s' from %s"_err_en_US, 500 symbol.name(), xType->AsFortran()); 501 } else { 502 context.messages().Say( 503 "Initialization expression cannot be converted to declared type of '%s'"_err_en_US, 504 symbol.name()); 505 } 506 } 507 return std::nullopt; 508 } 509 510 // Specification expression validation (10.1.11(2), C1010) 511 class CheckSpecificationExprHelper 512 : public AnyTraverse<CheckSpecificationExprHelper, 513 std::optional<std::string>> { 514 public: 515 using Result = std::optional<std::string>; 516 using Base = AnyTraverse<CheckSpecificationExprHelper, Result>; 517 explicit CheckSpecificationExprHelper(const semantics::Scope &s, 518 FoldingContext &context, bool forElementalFunctionResult) 519 : Base{*this}, scope_{s}, context_{context}, 520 forElementalFunctionResult_{forElementalFunctionResult} {} 521 using Base::operator(); 522 523 Result operator()(const CoarrayRef &) const { return "coindexed reference"; } 524 525 Result operator()(const semantics::Symbol &symbol) const { 526 const auto &ultimate{symbol.GetUltimate()}; 527 if (const auto *assoc{ 528 ultimate.detailsIf<semantics::AssocEntityDetails>()}) { 529 return (*this)(assoc->expr()); 530 } else if (semantics::IsNamedConstant(ultimate) || 531 ultimate.owner().IsModule() || ultimate.owner().IsSubmodule()) { 532 return std::nullopt; 533 } else if (scope_.IsDerivedType() && 534 IsVariableName(ultimate)) { // C750, C754 535 return "derived type component or type parameter value not allowed to " 536 "reference variable '"s + 537 ultimate.name().ToString() + "'"; 538 } else if (IsDummy(ultimate)) { 539 if (!inInquiry_ && forElementalFunctionResult_) { 540 return "dependence on value of dummy argument '"s + 541 ultimate.name().ToString() + "'"; 542 } else if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) { 543 return "reference to OPTIONAL dummy argument '"s + 544 ultimate.name().ToString() + "'"; 545 } else if (!inInquiry_ && 546 ultimate.attrs().test(semantics::Attr::INTENT_OUT)) { 547 return "reference to INTENT(OUT) dummy argument '"s + 548 ultimate.name().ToString() + "'"; 549 } else if (ultimate.has<semantics::ObjectEntityDetails>()) { 550 return std::nullopt; 551 } else { 552 return "dummy procedure argument"; 553 } 554 } else if (&symbol.owner() != &scope_ || &ultimate.owner() != &scope_) { 555 return std::nullopt; // host association is in play 556 } else if (const auto *object{ 557 ultimate.detailsIf<semantics::ObjectEntityDetails>()}) { 558 if (object->commonBlock()) { 559 return std::nullopt; 560 } 561 } 562 if (inInquiry_) { 563 return std::nullopt; 564 } else { 565 return "reference to local entity '"s + ultimate.name().ToString() + "'"; 566 } 567 } 568 569 Result operator()(const Component &x) const { 570 // Don't look at the component symbol. 571 return (*this)(x.base()); 572 } 573 Result operator()(const ArrayRef &x) const { 574 if (auto result{(*this)(x.base())}) { 575 return result; 576 } 577 // The subscripts don't get special protection for being in a 578 // specification inquiry context; 579 auto restorer{common::ScopedSet(inInquiry_, false)}; 580 return (*this)(x.subscript()); 581 } 582 Result operator()(const Substring &x) const { 583 if (auto result{(*this)(x.parent())}) { 584 return result; 585 } 586 // The bounds don't get special protection for being in a 587 // specification inquiry context; 588 auto restorer{common::ScopedSet(inInquiry_, false)}; 589 if (auto result{(*this)(x.lower())}) { 590 return result; 591 } 592 return (*this)(x.upper()); 593 } 594 Result operator()(const DescriptorInquiry &x) const { 595 // Many uses of SIZE(), LBOUND(), &c. that are valid in specification 596 // expressions will have been converted to expressions over descriptor 597 // inquiries by Fold(). 598 // Catch REAL, ALLOCATABLE :: X(:); REAL :: Y(SIZE(X)) 599 if (IsPermissibleInquiry( 600 x.base().GetFirstSymbol(), x.base().GetLastSymbol(), x.field())) { 601 auto restorer{common::ScopedSet(inInquiry_, true)}; 602 return (*this)(x.base()); 603 } else if (IsConstantExpr(x)) { 604 return std::nullopt; 605 } else { 606 return "non-constant descriptor inquiry not allowed for local object"; 607 } 608 } 609 610 Result operator()(const TypeParamInquiry &inq) const { 611 if (scope_.IsDerivedType()) { 612 if (!IsConstantExpr(inq) && 613 inq.base() /* X%T, not local T */) { // C750, C754 614 return "non-constant reference to a type parameter inquiry not allowed " 615 "for derived type components or type parameter values"; 616 } 617 } else if (inq.base() && 618 IsInquiryAlwaysPermissible(inq.base()->GetFirstSymbol())) { 619 auto restorer{common::ScopedSet(inInquiry_, true)}; 620 return (*this)(inq.base()); 621 } else if (!IsConstantExpr(inq)) { 622 return "non-constant type parameter inquiry not allowed for local object"; 623 } 624 return std::nullopt; 625 } 626 627 Result operator()(const ProcedureRef &x) const { 628 bool inInquiry{false}; 629 if (const auto *symbol{x.proc().GetSymbol()}) { 630 const Symbol &ultimate{symbol->GetUltimate()}; 631 if (!semantics::IsPureProcedure(ultimate)) { 632 return "reference to impure function '"s + ultimate.name().ToString() + 633 "'"; 634 } 635 if (semantics::IsStmtFunction(ultimate)) { 636 return "reference to statement function '"s + 637 ultimate.name().ToString() + "'"; 638 } 639 if (scope_.IsDerivedType()) { // C750, C754 640 return "reference to function '"s + ultimate.name().ToString() + 641 "' not allowed for derived type components or type parameter" 642 " values"; 643 } 644 if (auto procChars{characteristics::Procedure::Characterize( 645 x.proc(), context_, /*emitError=*/true)}) { 646 const auto iter{std::find_if(procChars->dummyArguments.begin(), 647 procChars->dummyArguments.end(), 648 [](const characteristics::DummyArgument &dummy) { 649 return std::holds_alternative<characteristics::DummyProcedure>( 650 dummy.u); 651 })}; 652 if (iter != procChars->dummyArguments.end()) { 653 return "reference to function '"s + ultimate.name().ToString() + 654 "' with dummy procedure argument '" + iter->name + '\''; 655 } 656 } 657 // References to internal functions are caught in expression semantics. 658 // TODO: other checks for standard module procedures 659 } else { // intrinsic 660 const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())}; 661 inInquiry = context_.intrinsics().GetIntrinsicClass(intrin.name) == 662 IntrinsicClass::inquiryFunction; 663 if (scope_.IsDerivedType()) { // C750, C754 664 if ((context_.intrinsics().IsIntrinsic(intrin.name) && 665 badIntrinsicsForComponents_.find(intrin.name) != 666 badIntrinsicsForComponents_.end())) { 667 return "reference to intrinsic '"s + intrin.name + 668 "' not allowed for derived type components or type parameter" 669 " values"; 670 } 671 if (inInquiry && !IsConstantExpr(x)) { 672 return "non-constant reference to inquiry intrinsic '"s + 673 intrin.name + 674 "' not allowed for derived type components or type" 675 " parameter values"; 676 } 677 } 678 // Type-determined inquiries (DIGITS, HUGE, &c.) will have already been 679 // folded and won't arrive here. Inquiries that are represented with 680 // DescriptorInquiry operations (LBOUND) are checked elsewhere. If a 681 // call that makes it to here satisfies the requirements of a constant 682 // expression (as Fortran defines it), it's fine. 683 if (IsConstantExpr(x)) { 684 return std::nullopt; 685 } 686 if (intrin.name == "present") { 687 return std::nullopt; // always ok 688 } 689 // Catch CHARACTER(:), ALLOCATABLE :: X; CHARACTER(LEN(X)) :: Y 690 if (inInquiry && x.arguments().size() >= 1) { 691 if (const auto &arg{x.arguments().at(0)}) { 692 if (auto dataRef{ExtractDataRef(*arg, true, true)}) { 693 if (intrin.name == "allocated" || intrin.name == "associated" || 694 intrin.name == "is_contiguous") { // ok 695 } else if (intrin.name == "len" && 696 IsPermissibleInquiry(dataRef->GetFirstSymbol(), 697 dataRef->GetLastSymbol(), 698 DescriptorInquiry::Field::Len)) { // ok 699 } else if (intrin.name == "lbound" && 700 IsPermissibleInquiry(dataRef->GetFirstSymbol(), 701 dataRef->GetLastSymbol(), 702 DescriptorInquiry::Field::LowerBound)) { // ok 703 } else if ((intrin.name == "shape" || intrin.name == "size" || 704 intrin.name == "sizeof" || 705 intrin.name == "storage_size" || 706 intrin.name == "ubound") && 707 IsPermissibleInquiry(dataRef->GetFirstSymbol(), 708 dataRef->GetLastSymbol(), 709 DescriptorInquiry::Field::Extent)) { // ok 710 } else { 711 return "non-constant inquiry function '"s + intrin.name + 712 "' not allowed for local object"; 713 } 714 } 715 } 716 } 717 } 718 auto restorer{common::ScopedSet(inInquiry_, inInquiry)}; 719 return (*this)(x.arguments()); 720 } 721 722 private: 723 const semantics::Scope &scope_; 724 FoldingContext &context_; 725 // Contextual information: this flag is true when in an argument to 726 // an inquiry intrinsic like SIZE(). 727 mutable bool inInquiry_{false}; 728 bool forElementalFunctionResult_{false}; // F'2023 C15121 729 const std::set<std::string> badIntrinsicsForComponents_{ 730 "allocated", "associated", "extends_type_of", "present", "same_type_as"}; 731 732 bool IsInquiryAlwaysPermissible(const semantics::Symbol &) const; 733 bool IsPermissibleInquiry(const semantics::Symbol &firstSymbol, 734 const semantics::Symbol &lastSymbol, 735 DescriptorInquiry::Field field) const; 736 }; 737 738 bool CheckSpecificationExprHelper::IsInquiryAlwaysPermissible( 739 const semantics::Symbol &symbol) const { 740 if (&symbol.owner() != &scope_ || symbol.has<semantics::UseDetails>() || 741 symbol.owner().kind() == semantics::Scope::Kind::Module || 742 semantics::FindCommonBlockContaining(symbol) || 743 symbol.has<semantics::HostAssocDetails>()) { 744 return true; // it's nonlocal 745 } else if (semantics::IsDummy(symbol) && !forElementalFunctionResult_) { 746 return true; 747 } else { 748 return false; 749 } 750 } 751 752 bool CheckSpecificationExprHelper::IsPermissibleInquiry( 753 const semantics::Symbol &firstSymbol, const semantics::Symbol &lastSymbol, 754 DescriptorInquiry::Field field) const { 755 if (IsInquiryAlwaysPermissible(firstSymbol)) { 756 return true; 757 } 758 // Inquiries on local objects may not access a deferred bound or length. 759 // (This code used to be a switch, but it proved impossible to write it 760 // thus without running afoul of bogus warnings from different C++ 761 // compilers.) 762 if (field == DescriptorInquiry::Field::Rank) { 763 return true; // always known 764 } 765 const auto *object{lastSymbol.detailsIf<semantics::ObjectEntityDetails>()}; 766 if (field == DescriptorInquiry::Field::LowerBound || 767 field == DescriptorInquiry::Field::Extent || 768 field == DescriptorInquiry::Field::Stride) { 769 return object && !object->shape().CanBeDeferredShape(); 770 } 771 if (field == DescriptorInquiry::Field::Len) { 772 return object && object->type() && 773 object->type()->category() == semantics::DeclTypeSpec::Character && 774 !object->type()->characterTypeSpec().length().isDeferred(); 775 } 776 return false; 777 } 778 779 template <typename A> 780 void CheckSpecificationExpr(const A &x, const semantics::Scope &scope, 781 FoldingContext &context, bool forElementalFunctionResult) { 782 if (auto why{CheckSpecificationExprHelper{ 783 scope, context, forElementalFunctionResult}(x)}) { 784 context.messages().Say("Invalid specification expression%s: %s"_err_en_US, 785 forElementalFunctionResult ? " for elemental function result" : "", 786 *why); 787 } 788 } 789 790 template void CheckSpecificationExpr(const Expr<SomeType> &, 791 const semantics::Scope &, FoldingContext &, 792 bool forElementalFunctionResult); 793 template void CheckSpecificationExpr(const Expr<SomeInteger> &, 794 const semantics::Scope &, FoldingContext &, 795 bool forElementalFunctionResult); 796 template void CheckSpecificationExpr(const Expr<SubscriptInteger> &, 797 const semantics::Scope &, FoldingContext &, 798 bool forElementalFunctionResult); 799 template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &, 800 const semantics::Scope &, FoldingContext &, 801 bool forElementalFunctionResult); 802 template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &, 803 const semantics::Scope &, FoldingContext &, 804 bool forElementalFunctionResult); 805 template void CheckSpecificationExpr( 806 const std::optional<Expr<SubscriptInteger>> &, const semantics::Scope &, 807 FoldingContext &, bool forElementalFunctionResult); 808 809 // IsContiguous() -- 9.5.4 810 class IsContiguousHelper 811 : public AnyTraverse<IsContiguousHelper, std::optional<bool>> { 812 public: 813 using Result = std::optional<bool>; // tri-state 814 using Base = AnyTraverse<IsContiguousHelper, Result>; 815 explicit IsContiguousHelper(FoldingContext &c) : Base{*this}, context_{c} {} 816 using Base::operator(); 817 818 template <typename T> Result operator()(const Constant<T> &) const { 819 return true; 820 } 821 Result operator()(const StaticDataObject &) const { return true; } 822 Result operator()(const semantics::Symbol &symbol) const { 823 const auto &ultimate{symbol.GetUltimate()}; 824 if (ultimate.attrs().test(semantics::Attr::CONTIGUOUS)) { 825 return true; 826 } else if (!IsVariable(symbol)) { 827 return true; 828 } else if (ultimate.Rank() == 0) { 829 // Extension: accept scalars as a degenerate case of 830 // simple contiguity to allow their use in contexts like 831 // data targets in pointer assignments with remapping. 832 return true; 833 } else if (const auto *details{ 834 ultimate.detailsIf<semantics::AssocEntityDetails>()}) { 835 // RANK(*) associating entity is contiguous. 836 if (details->IsAssumedSize()) { 837 return true; 838 } else { 839 return Base::operator()(ultimate); // use expr 840 } 841 } else if (semantics::IsPointer(ultimate) || 842 semantics::IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) { 843 return std::nullopt; 844 } else if (ultimate.has<semantics::ObjectEntityDetails>()) { 845 return true; 846 } else { 847 return Base::operator()(ultimate); 848 } 849 } 850 851 Result operator()(const ArrayRef &x) const { 852 if (x.Rank() == 0) { 853 return true; // scalars considered contiguous 854 } 855 int subscriptRank{0}; 856 auto baseLbounds{GetLBOUNDs(context_, x.base())}; 857 auto baseUbounds{GetUBOUNDs(context_, x.base())}; 858 auto subscripts{CheckSubscripts( 859 x.subscript(), subscriptRank, &baseLbounds, &baseUbounds)}; 860 if (!subscripts.value_or(false)) { 861 return subscripts; // subscripts not known to be contiguous 862 } else if (subscriptRank > 0) { 863 // a(1)%b(:,:) is contiguous if and only if a(1)%b is contiguous. 864 return (*this)(x.base()); 865 } else { 866 // a(:)%b(1,1) is (probably) not contiguous. 867 return std::nullopt; 868 } 869 } 870 Result operator()(const CoarrayRef &x) const { 871 int rank{0}; 872 return CheckSubscripts(x.subscript(), rank).has_value(); 873 } 874 Result operator()(const Component &x) const { 875 if (x.base().Rank() == 0) { 876 return (*this)(x.GetLastSymbol()); 877 } else { 878 if (Result baseIsContiguous{(*this)(x.base())}) { 879 if (!*baseIsContiguous) { 880 return false; 881 } 882 // TODO could be true if base contiguous and this is only component, or 883 // if base has only one element? 884 } 885 return std::nullopt; 886 } 887 } 888 Result operator()(const ComplexPart &x) const { 889 return x.complex().Rank() == 0; 890 } 891 Result operator()(const Substring &) const { return std::nullopt; } 892 893 Result operator()(const ProcedureRef &x) const { 894 if (auto chars{characteristics::Procedure::Characterize( 895 x.proc(), context_, /*emitError=*/true)}) { 896 if (chars->functionResult) { 897 const auto &result{*chars->functionResult}; 898 if (!result.IsProcedurePointer()) { 899 if (result.attrs.test( 900 characteristics::FunctionResult::Attr::Contiguous)) { 901 return true; 902 } 903 if (!result.attrs.test( 904 characteristics::FunctionResult::Attr::Pointer)) { 905 return true; 906 } 907 if (const auto *type{result.GetTypeAndShape()}; 908 type && type->Rank() == 0) { 909 return true; // pointer to scalar 910 } 911 // Must be non-CONTIGUOUS pointer to array 912 } 913 } 914 } 915 return std::nullopt; 916 } 917 918 Result operator()(const NullPointer &) const { return true; } 919 920 private: 921 // Returns "true" for a provably empty or simply contiguous array section; 922 // return "false" for a provably nonempty discontiguous section or for use 923 // of a vector subscript. 924 std::optional<bool> CheckSubscripts(const std::vector<Subscript> &subscript, 925 int &rank, const Shape *baseLbounds = nullptr, 926 const Shape *baseUbounds = nullptr) const { 927 bool anyTriplet{false}; 928 rank = 0; 929 // Detect any provably empty dimension in this array section, which would 930 // render the whole section empty and therefore vacuously contiguous. 931 std::optional<bool> result; 932 bool mayBeEmpty{false}; 933 auto dims{subscript.size()}; 934 std::vector<bool> knownPartialSlice(dims, false); 935 for (auto j{dims}; j-- > 0;) { 936 std::optional<ConstantSubscript> dimLbound; 937 std::optional<ConstantSubscript> dimUbound; 938 std::optional<ConstantSubscript> dimExtent; 939 if (baseLbounds && j < baseLbounds->size()) { 940 if (const auto &lb{baseLbounds->at(j)}) { 941 dimLbound = ToInt64(Fold(context_, Expr<SubscriptInteger>{*lb})); 942 } 943 } 944 if (baseUbounds && j < baseUbounds->size()) { 945 if (const auto &ub{baseUbounds->at(j)}) { 946 dimUbound = ToInt64(Fold(context_, Expr<SubscriptInteger>{*ub})); 947 } 948 } 949 if (dimLbound && dimUbound) { 950 if (*dimLbound <= *dimUbound) { 951 dimExtent = *dimUbound - *dimLbound + 1; 952 } else { 953 // This is an empty dimension. 954 result = true; 955 dimExtent = 0; 956 } 957 } 958 959 if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) { 960 ++rank; 961 if (auto stride{ToInt64(triplet->stride())}) { 962 const Expr<SubscriptInteger> *lowerBound{triplet->GetLower()}; 963 const Expr<SubscriptInteger> *upperBound{triplet->GetUpper()}; 964 std::optional<ConstantSubscript> lowerVal{lowerBound 965 ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*lowerBound})) 966 : dimLbound}; 967 std::optional<ConstantSubscript> upperVal{upperBound 968 ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*upperBound})) 969 : dimUbound}; 970 if (lowerVal && upperVal) { 971 if (*lowerVal < *upperVal) { 972 if (*stride < 0) { 973 result = true; // empty dimension 974 } else if (!result && *stride > 1 && 975 *lowerVal + *stride <= *upperVal) { 976 result = false; // discontiguous if not empty 977 } 978 } else if (*lowerVal > *upperVal) { 979 if (*stride > 0) { 980 result = true; // empty dimension 981 } else if (!result && *stride < 0 && 982 *lowerVal + *stride >= *upperVal) { 983 result = false; // discontiguous if not empty 984 } 985 } else { 986 mayBeEmpty = true; 987 } 988 } else { 989 mayBeEmpty = true; 990 } 991 } else { 992 mayBeEmpty = true; 993 } 994 } else if (subscript[j].Rank() > 0) { 995 ++rank; 996 if (!result) { 997 result = false; // vector subscript 998 } 999 mayBeEmpty = true; 1000 } else { 1001 // Scalar subscript. 1002 if (dimExtent && *dimExtent > 1) { 1003 knownPartialSlice[j] = true; 1004 } 1005 } 1006 } 1007 if (rank == 0) { 1008 result = true; // scalar 1009 } 1010 if (result) { 1011 return result; 1012 } 1013 // Not provably discontiguous at this point. 1014 // Return "true" if simply contiguous, otherwise nullopt. 1015 for (auto j{subscript.size()}; j-- > 0;) { 1016 if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) { 1017 auto stride{ToInt64(triplet->stride())}; 1018 if (!stride || stride != 1) { 1019 return std::nullopt; 1020 } else if (anyTriplet) { 1021 if (triplet->GetLower() || triplet->GetUpper()) { 1022 // all triplets before the last one must be just ":" for 1023 // simple contiguity 1024 return std::nullopt; 1025 } 1026 } else { 1027 anyTriplet = true; 1028 } 1029 ++rank; 1030 } else if (anyTriplet) { 1031 // If the section cannot be empty, and this dimension's 1032 // scalar subscript is known not to cover the whole 1033 // dimension, then the array section is provably 1034 // discontiguous. 1035 return (mayBeEmpty || !knownPartialSlice[j]) 1036 ? std::nullopt 1037 : std::make_optional(false); 1038 } 1039 } 1040 return true; // simply contiguous 1041 } 1042 1043 FoldingContext &context_; 1044 }; 1045 1046 template <typename A> 1047 std::optional<bool> IsContiguous(const A &x, FoldingContext &context) { 1048 return IsContiguousHelper{context}(x); 1049 } 1050 1051 template std::optional<bool> IsContiguous( 1052 const Expr<SomeType> &, FoldingContext &); 1053 template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &); 1054 template std::optional<bool> IsContiguous(const Substring &, FoldingContext &); 1055 template std::optional<bool> IsContiguous(const Component &, FoldingContext &); 1056 template std::optional<bool> IsContiguous( 1057 const ComplexPart &, FoldingContext &); 1058 template std::optional<bool> IsContiguous(const CoarrayRef &, FoldingContext &); 1059 template std::optional<bool> IsContiguous(const Symbol &, FoldingContext &); 1060 1061 // IsErrorExpr() 1062 struct IsErrorExprHelper : public AnyTraverse<IsErrorExprHelper, bool> { 1063 using Result = bool; 1064 using Base = AnyTraverse<IsErrorExprHelper, Result>; 1065 IsErrorExprHelper() : Base{*this} {} 1066 using Base::operator(); 1067 1068 bool operator()(const SpecificIntrinsic &x) { 1069 return x.name == IntrinsicProcTable::InvalidName; 1070 } 1071 }; 1072 1073 template <typename A> bool IsErrorExpr(const A &x) { 1074 return IsErrorExprHelper{}(x); 1075 } 1076 1077 template bool IsErrorExpr(const Expr<SomeType> &); 1078 1079 // C1577 1080 // TODO: Also check C1579 & C1582 here 1081 class StmtFunctionChecker 1082 : public AnyTraverse<StmtFunctionChecker, std::optional<parser::Message>> { 1083 public: 1084 using Result = std::optional<parser::Message>; 1085 using Base = AnyTraverse<StmtFunctionChecker, Result>; 1086 StmtFunctionChecker(const Symbol &sf, FoldingContext &context) 1087 : Base{*this}, sf_{sf}, context_{context} { 1088 if (!context_.languageFeatures().IsEnabled( 1089 common::LanguageFeature::StatementFunctionExtensions)) { 1090 severity_ = parser::Severity::Error; 1091 } else if (context_.languageFeatures().ShouldWarn( 1092 common::LanguageFeature::StatementFunctionExtensions)) { 1093 severity_ = parser::Severity::Portability; 1094 } 1095 } 1096 using Base::operator(); 1097 1098 template <typename T> Result operator()(const ArrayConstructor<T> &) const { 1099 if (severity_) { 1100 auto msg{ 1101 "Statement function '%s' should not contain an array constructor"_port_en_US}; 1102 msg.set_severity(*severity_); 1103 return parser::Message{sf_.name(), std::move(msg), sf_.name()}; 1104 } else { 1105 return std::nullopt; 1106 } 1107 } 1108 Result operator()(const StructureConstructor &) const { 1109 if (severity_) { 1110 auto msg{ 1111 "Statement function '%s' should not contain a structure constructor"_port_en_US}; 1112 msg.set_severity(*severity_); 1113 return parser::Message{sf_.name(), std::move(msg), sf_.name()}; 1114 } else { 1115 return std::nullopt; 1116 } 1117 } 1118 Result operator()(const TypeParamInquiry &) const { 1119 if (severity_) { 1120 auto msg{ 1121 "Statement function '%s' should not contain a type parameter inquiry"_port_en_US}; 1122 msg.set_severity(*severity_); 1123 return parser::Message{sf_.name(), std::move(msg), sf_.name()}; 1124 } else { 1125 return std::nullopt; 1126 } 1127 } 1128 Result operator()(const ProcedureDesignator &proc) const { 1129 if (const Symbol * symbol{proc.GetSymbol()}) { 1130 const Symbol &ultimate{symbol->GetUltimate()}; 1131 if (const auto *subp{ 1132 ultimate.detailsIf<semantics::SubprogramDetails>()}) { 1133 if (subp->stmtFunction() && &ultimate.owner() == &sf_.owner()) { 1134 if (ultimate.name().begin() > sf_.name().begin()) { 1135 return parser::Message{sf_.name(), 1136 "Statement function '%s' may not reference another statement function '%s' that is defined later"_err_en_US, 1137 sf_.name(), ultimate.name()}; 1138 } 1139 } 1140 } 1141 if (auto chars{characteristics::Procedure::Characterize( 1142 proc, context_, /*emitError=*/true)}) { 1143 if (!chars->CanBeCalledViaImplicitInterface()) { 1144 if (severity_) { 1145 auto msg{ 1146 "Statement function '%s' should not reference function '%s' that requires an explicit interface"_port_en_US}; 1147 msg.set_severity(*severity_); 1148 return parser::Message{ 1149 sf_.name(), std::move(msg), sf_.name(), symbol->name()}; 1150 } 1151 } 1152 } 1153 } 1154 if (proc.Rank() > 0) { 1155 if (severity_) { 1156 auto msg{ 1157 "Statement function '%s' should not reference a function that returns an array"_port_en_US}; 1158 msg.set_severity(*severity_); 1159 return parser::Message{sf_.name(), std::move(msg), sf_.name()}; 1160 } 1161 } 1162 return std::nullopt; 1163 } 1164 Result operator()(const ActualArgument &arg) const { 1165 if (const auto *expr{arg.UnwrapExpr()}) { 1166 if (auto result{(*this)(*expr)}) { 1167 return result; 1168 } 1169 if (expr->Rank() > 0 && !UnwrapWholeSymbolOrComponentDataRef(*expr)) { 1170 if (severity_) { 1171 auto msg{ 1172 "Statement function '%s' should not pass an array argument that is not a whole array"_port_en_US}; 1173 msg.set_severity(*severity_); 1174 return parser::Message{sf_.name(), std::move(msg), sf_.name()}; 1175 } 1176 } 1177 } 1178 return std::nullopt; 1179 } 1180 1181 private: 1182 const Symbol &sf_; 1183 FoldingContext &context_; 1184 std::optional<parser::Severity> severity_; 1185 }; 1186 1187 std::optional<parser::Message> CheckStatementFunction( 1188 const Symbol &sf, const Expr<SomeType> &expr, FoldingContext &context) { 1189 return StmtFunctionChecker{sf, context}(expr); 1190 } 1191 1192 } // namespace Fortran::evaluate 1193