flang/lib/Semantics/pointer-assignment.cpp

   1 //===-- lib/Semantics/pointer-assignment.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 "pointer-assignment.h"
  10 #include "definable.h"
  11 #include "flang/Common/idioms.h"
  12 #include "flang/Common/restorer.h"
  13 #include "flang/Common/template.h"
  14 #include "flang/Evaluate/characteristics.h"
  15 #include "flang/Evaluate/expression.h"
  16 #include "flang/Evaluate/fold.h"
  17 #include "flang/Evaluate/tools.h"
  18 #include "flang/Parser/message.h"
  19 #include "flang/Parser/parse-tree-visitor.h"
  20 #include "flang/Parser/parse-tree.h"
  21 #include "flang/Semantics/expression.h"
  22 #include "flang/Semantics/symbol.h"
  23 #include "flang/Semantics/tools.h"
  24 #include "llvm/Support/raw_ostream.h"
  25 #include <optional>
  26 #include <set>
  27 #include <string>
  28 #include <type_traits>
  29
  30 // Semantic checks for pointer assignment.
  31
  32 namespace Fortran::semantics {
  33
  34 using namespace parser::literals;
  35 using evaluate::characteristics::DummyDataObject;
  36 using evaluate::characteristics::FunctionResult;
  37 using evaluate::characteristics::Procedure;
  38 using evaluate::characteristics::TypeAndShape;
  39 using parser::MessageFixedText;
  40 using parser::MessageFormattedText;
  41
  42 class PointerAssignmentChecker {
  43 public:
  44   PointerAssignmentChecker(SemanticsContext &context, const Scope &scope,
  45       parser::CharBlock source, const std::string &description)
  46       : context_{context}, scope_{scope}, source_{source}, description_{
  47                                                                description} {}
  48   PointerAssignmentChecker(
  49       SemanticsContext &context, const Scope &scope, const Symbol &lhs)
  50       : context_{context}, scope_{scope}, source_{lhs.name()},
  51         description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
  52     set_lhsType(TypeAndShape::Characterize(lhs, foldingContext_));
  53     set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS));
  54     set_isVolatile(lhs.attrs().test(Attr::VOLATILE));
  55   }
  56   PointerAssignmentChecker &set_lhsType(std::optional<TypeAndShape> &&);
  57   PointerAssignmentChecker &set_isContiguous(bool);
  58   PointerAssignmentChecker &set_isVolatile(bool);
  59   PointerAssignmentChecker &set_isBoundsRemapping(bool);
  60   PointerAssignmentChecker &set_isAssumedRank(bool);
  61   PointerAssignmentChecker &set_pointerComponentLHS(const Symbol *);
  62   bool CheckLeftHandSide(const SomeExpr &);
  63   bool Check(const SomeExpr &);
  64
  65 private:
  66   bool CharacterizeProcedure();
  67   template <typename T> bool Check(const T &);
  68   template <typename T> bool Check(const evaluate::Expr<T> &);
  69   template <typename T> bool Check(const evaluate::FunctionRef<T> &);
  70   template <typename T> bool Check(const evaluate::Designator<T> &);
  71   bool Check(const evaluate::NullPointer &);
  72   bool Check(const evaluate::ProcedureDesignator &);
  73   bool Check(const evaluate::ProcedureRef &);
  74   // Target is a procedure
  75   bool Check(parser::CharBlock rhsName, bool isCall,
  76       const Procedure * = nullptr,
  77       const evaluate::SpecificIntrinsic *specific = nullptr);
  78   bool LhsOkForUnlimitedPoly() const;
  79   template <typename... A> parser::Message *Say(A &&...);
  80
  81   SemanticsContext &context_;
  82   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
  83   const Scope &scope_;
  84   const parser::CharBlock source_;
  85   const std::string description_;
  86   const Symbol *lhs_{nullptr};
  87   std::optional<TypeAndShape> lhsType_;
  88   std::optional<Procedure> procedure_;
  89   bool characterizedProcedure_{false};
  90   bool isContiguous_{false};
  91   bool isVolatile_{false};
  92   bool isBoundsRemapping_{false};
  93   bool isAssumedRank_{false};
  94   const Symbol *pointerComponentLHS_{nullptr};
  95 };
  96
  97 PointerAssignmentChecker &PointerAssignmentChecker::set_lhsType(
  98     std::optional<TypeAndShape> &&lhsType) {
  99   lhsType_ = std::move(lhsType);
 100   return *this;
 101 }
 102
 103 PointerAssignmentChecker &PointerAssignmentChecker::set_isContiguous(
 104     bool isContiguous) {
 105   isContiguous_ = isContiguous;
 106   return *this;
 107 }
 108
 109 PointerAssignmentChecker &PointerAssignmentChecker::set_isVolatile(
 110     bool isVolatile) {
 111   isVolatile_ = isVolatile;
 112   return *this;
 113 }
 114
 115 PointerAssignmentChecker &PointerAssignmentChecker::set_isBoundsRemapping(
 116     bool isBoundsRemapping) {
 117   isBoundsRemapping_ = isBoundsRemapping;
 118   return *this;
 119 }
 120
 121 PointerAssignmentChecker &PointerAssignmentChecker::set_isAssumedRank(
 122     bool isAssumedRank) {
 123   isAssumedRank_ = isAssumedRank;
 124   return *this;
 125 }
 126
 127 PointerAssignmentChecker &PointerAssignmentChecker::set_pointerComponentLHS(
 128     const Symbol *symbol) {
 129   pointerComponentLHS_ = symbol;
 130   return *this;
 131 }
 132
 133 bool PointerAssignmentChecker::CharacterizeProcedure() {
 134   if (!characterizedProcedure_) {
 135     characterizedProcedure_ = true;
 136     if (lhs_ && IsProcedure(*lhs_)) {
 137       procedure_ = Procedure::Characterize(*lhs_, foldingContext_);
 138     }
 139   }
 140   return procedure_.has_value();
 141 }
 142
 143 bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
 144   if (auto whyNot{WhyNotDefinable(foldingContext_.messages().at(), scope_,
 145           DefinabilityFlags{DefinabilityFlag::PointerDefinition}, lhs)}) {
 146     if (auto *msg{Say(
 147             "The left-hand side of a pointer assignment is not definable"_err_en_US)}) {
 148       msg->Attach(std::move(*whyNot));
 149     }
 150     return false;
 151   } else {
 152     return true;
 153   }
 154 }
 155
 156 template <typename T> bool PointerAssignmentChecker::Check(const T &) {
 157   // Catch-all case for really bad target expression
 158   Say("Target associated with %s must be a designator or a call to a"
 159       " pointer-valued function"_err_en_US,
 160       description_);
 161   return false;
 162 }
 163
 164 template <typename T>
 165 bool PointerAssignmentChecker::Check(const evaluate::Expr<T> &x) {
 166   return common::visit([&](const auto &x) { return Check(x); }, x.u);
 167 }
 168
 169 bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
 170   if (HasVectorSubscript(rhs)) { // C1025
 171     Say("An array section with a vector subscript may not be a pointer target"_err_en_US);
 172     return false;
 173   }
 174   if (ExtractCoarrayRef(rhs)) { // C1026
 175     Say("A coindexed object may not be a pointer target"_err_en_US);
 176     return false;
 177   }
 178   if (!common::visit([&](const auto &x) { return Check(x); }, rhs.u)) {
 179     return false;
 180   }
 181   if (IsNullPointer(rhs)) {
 182     return true;
 183   }
 184   if (lhs_ && IsProcedure(*lhs_)) {
 185     return true;
 186   }
 187   if (const auto *pureProc{FindPureProcedureContaining(scope_)}) {
 188     if (pointerComponentLHS_) { // C1594(4) is a hard error
 189       if (const Symbol * object{FindExternallyVisibleObject(rhs, *pureProc)}) {
 190         if (auto *msg{Say(
 191                 "Externally visible object '%s' may not be associated with pointer component '%s' in a pure procedure"_err_en_US,
 192                 object->name(), pointerComponentLHS_->name())}) {
 193           msg->Attach(object->name(), "Object declaration"_en_US)
 194               .Attach(
 195                   pointerComponentLHS_->name(), "Pointer declaration"_en_US);
 196         }
 197         return false;
 198       }
 199     } else if (const Symbol * base{GetFirstSymbol(rhs)}) {
 200       if (const char *why{WhyBaseObjectIsSuspicious(
 201               base->GetUltimate(), scope_)}) { // C1594(3)
 202         evaluate::SayWithDeclaration(foldingContext_.messages(), *base,
 203             "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
 204             base->name(), why);
 205         return false;
 206       }
 207     }
 208   }
 209   if (isContiguous_) {
 210     if (auto contiguous{evaluate::IsContiguous(rhs, foldingContext_)}) {
 211       if (!*contiguous) {
 212         Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
 213         return false;
 214       }
 215     } else if (context_.ShouldWarn(
 216                    common::UsageWarning::PointerToPossibleNoncontiguous)) {
 217       Say("Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
 218     }
 219   }
 220   // Warn about undefinable data targets
 221   if (context_.ShouldWarn(common::UsageWarning::PointerToUndefinable)) {
 222     if (auto because{WhyNotDefinable(
 223             foldingContext_.messages().at(), scope_, {}, rhs)}) {
 224       if (auto *msg{
 225               Say("Pointer target is not a definable variable"_warn_en_US)}) {
 226         msg->Attach(std::move(*because));
 227       }
 228       return false;
 229     }
 230   }
 231   return true;
 232 }
 233
 234 bool PointerAssignmentChecker::Check(const evaluate::NullPointer &) {
 235   return true; // P => NULL() without MOLD=; always OK
 236 }
 237
 238 template <typename T>
 239 bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
 240   std::string funcName;
 241   const auto *symbol{f.proc().GetSymbol()};
 242   if (symbol) {
 243     funcName = symbol->name().ToString();
 244   } else if (const auto *intrinsic{f.proc().GetSpecificIntrinsic()}) {
 245     funcName = intrinsic->name;
 246   }
 247   auto proc{Procedure::Characterize(f.proc(), foldingContext_)};
 248   if (!proc) {
 249     return false;
 250   }
 251   std::optional<MessageFixedText> msg;
 252   const auto &funcResult{proc->functionResult}; // C1025
 253   if (!funcResult) {
 254     msg = "%s is associated with the non-existent result of reference to"
 255           " procedure"_err_en_US;
 256   } else if (CharacterizeProcedure()) {
 257     // Shouldn't be here in this function unless lhs is an object pointer.
 258     msg = "Procedure %s is associated with the result of a reference to"
 259           " function '%s' that does not return a procedure pointer"_err_en_US;
 260   } else if (funcResult->IsProcedurePointer()) {
 261     msg = "Object %s is associated with the result of a reference to"
 262           " function '%s' that is a procedure pointer"_err_en_US;
 263   } else if (!funcResult->attrs.test(FunctionResult::Attr::Pointer)) {
 264     msg = "%s is associated with the result of a reference to function '%s'"
 265           " that is a not a pointer"_err_en_US;
 266   } else if (isContiguous_ &&
 267       !funcResult->attrs.test(FunctionResult::Attr::Contiguous)) {
 268     msg = "CONTIGUOUS %s is associated with the result of reference to"
 269           " function '%s' that is not contiguous"_err_en_US;
 270   } else if (lhsType_) {
 271     const auto *frTypeAndShape{funcResult->GetTypeAndShape()};
 272     CHECK(frTypeAndShape);
 273     if (!lhsType_->IsCompatibleWith(foldingContext_.messages(), *frTypeAndShape,
 274             "pointer", "function result",
 275             /*omitShapeConformanceCheck=*/isBoundsRemapping_ || isAssumedRank_,
 276             evaluate::CheckConformanceFlags::BothDeferredShape)) {
 277       return false; // IsCompatibleWith() emitted message
 278     }
 279   }
 280   if (msg) {
 281     auto restorer{common::ScopedSet(lhs_, symbol)};
 282     Say(*msg, description_, funcName);
 283     return false;
 284   }
 285   return true;
 286 }
 287
 288 template <typename T>
 289 bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
 290   const Symbol *last{d.GetLastSymbol()};
 291   const Symbol *base{d.GetBaseObject().symbol()};
 292   if (!last || !base) {
 293     // P => "character literal"(1:3)
 294     Say("Pointer target is not a named entity"_err_en_US);
 295     return false;
 296   }
 297   std::optional<std::variant<MessageFixedText, MessageFormattedText>> msg;
 298   if (CharacterizeProcedure()) {
 299     // Shouldn't be here in this function unless lhs is an object pointer.
 300     msg = "In assignment to procedure %s, the target is not a procedure or"
 301           " procedure pointer"_err_en_US;
 302   } else if (!evaluate::GetLastTarget(GetSymbolVector(d))) { // C1025
 303     msg = "In assignment to object %s, the target '%s' is not an object with"
 304           " POINTER or TARGET attributes"_err_en_US;
 305   } else if (auto rhsType{TypeAndShape::Characterize(d, foldingContext_)}) {
 306     if (!lhsType_) {
 307       msg = "%s associated with object '%s' with incompatible type or"
 308             " shape"_err_en_US;
 309     } else if (rhsType->corank() > 0 &&
 310         (isVolatile_ != last->attrs().test(Attr::VOLATILE))) { // C1020
 311       // TODO: what if A is VOLATILE in A%B%C?  need a better test here
 312       if (isVolatile_) {
 313         msg = "Pointer may not be VOLATILE when target is a"
 314               " non-VOLATILE coarray"_err_en_US;
 315       } else {
 316         msg = "Pointer must be VOLATILE when target is a"
 317               " VOLATILE coarray"_err_en_US;
 318       }
 319     } else if (rhsType->type().IsUnlimitedPolymorphic()) {
 320       if (!LhsOkForUnlimitedPoly()) {
 321         msg = "Pointer type must be unlimited polymorphic or non-extensible"
 322               " derived type when target is unlimited polymorphic"_err_en_US;
 323       }
 324     } else {
 325       if (!lhsType_->type().IsTkLenCompatibleWith(rhsType->type())) {
 326         msg = MessageFormattedText{
 327             "Target type %s is not compatible with pointer type %s"_err_en_US,
 328             rhsType->type().AsFortran(), lhsType_->type().AsFortran()};
 329
 330       } else if (!isBoundsRemapping_ &&
 331           !lhsType_->attrs().test(TypeAndShape::Attr::AssumedRank)) {
 332         int lhsRank{evaluate::GetRank(lhsType_->shape())};
 333         int rhsRank{evaluate::GetRank(rhsType->shape())};
 334         if (lhsRank != rhsRank) {
 335           msg = MessageFormattedText{
 336               "Pointer has rank %d but target has rank %d"_err_en_US, lhsRank,
 337               rhsRank};
 338         }
 339       }
 340     }
 341   }
 342   if (msg) {
 343     auto restorer{common::ScopedSet(lhs_, last)};
 344     if (auto *m{std::get_if<MessageFixedText>(&*msg)}) {
 345       std::string buf;
 346       llvm::raw_string_ostream ss{buf};
 347       d.AsFortran(ss);
 348       Say(*m, description_, ss.str());
 349     } else {
 350       Say(std::get<MessageFormattedText>(*msg));
 351     }
 352     return false;
 353   }
 354   return true;
 355 }
 356
 357 // Common handling for procedure pointer right-hand sides
 358 bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
 359     const Procedure *rhsProcedure,
 360     const evaluate::SpecificIntrinsic *specific) {
 361   std::string whyNot;
 362   std::optional<std::string> warning;
 363   CharacterizeProcedure();
 364   if (std::optional<MessageFixedText> msg{evaluate::CheckProcCompatibility(
 365           isCall, procedure_, rhsProcedure, specific, whyNot, warning)}) {
 366     Say(std::move(*msg), description_, rhsName, whyNot);
 367     return false;
 368   }
 369   if (context_.ShouldWarn(common::UsageWarning::ProcDummyArgShapes) &&
 370       warning) {
 371     Say("%s and %s may not be completely compatible procedures: %s"_warn_en_US,
 372         description_, rhsName, std::move(*warning));
 373   }
 374   return true;
 375 }
 376
 377 bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
 378   const Symbol *symbol{d.GetSymbol()};
 379   if (symbol) {
 380     if (const auto *subp{
 381             symbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
 382       if (subp->stmtFunction()) {
 383         evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
 384             "Statement function '%s' may not be the target of a pointer assignment"_err_en_US,
 385             symbol->name());
 386         return false;
 387       }
 388     } else if (symbol->has<ProcBindingDetails>() &&
 389         context_.ShouldWarn(common::LanguageFeature::BindingAsProcedure)) {
 390       evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
 391           "Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
 392           symbol->name());
 393     }
 394   }
 395   if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
 396     // Disregard the elemental attribute of RHS intrinsics.
 397     if (symbol && symbol->GetUltimate().attrs().test(Attr::INTRINSIC)) {
 398       chars->attrs.reset(Procedure::Attr::Elemental);
 399     }
 400     return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
 401   } else {
 402     return Check(d.GetName(), false);
 403   }
 404 }
 405
 406 bool PointerAssignmentChecker::Check(const evaluate::ProcedureRef &ref) {
 407   auto chars{Procedure::Characterize(ref, foldingContext_)};
 408   return Check(ref.proc().GetName(), true, common::GetPtrFromOptional(chars));
 409 }
 410
 411 // The target can be unlimited polymorphic if the pointer is, or if it is
 412 // a non-extensible derived type.
 413 bool PointerAssignmentChecker::LhsOkForUnlimitedPoly() const {
 414   const auto &type{lhsType_->type()};
 415   if (type.category() != TypeCategory::Derived || type.IsAssumedType()) {
 416     return false;
 417   } else if (type.IsUnlimitedPolymorphic()) {
 418     return true;
 419   } else {
 420     return !IsExtensibleType(&type.GetDerivedTypeSpec());
 421   }
 422 }
 423
 424 template <typename... A>
 425 parser::Message *PointerAssignmentChecker::Say(A &&...x) {
 426   auto *msg{foldingContext_.messages().Say(std::forward<A>(x)...)};
 427   if (msg) {
 428     if (lhs_) {
 429       return evaluate::AttachDeclaration(msg, *lhs_);
 430     }
 431     if (!source_.empty()) {
 432       msg->Attach(source_, "Declaration of %s"_en_US, description_);
 433     }
 434   }
 435   return msg;
 436 }
 437
 438 // Verify that any bounds on the LHS of a pointer assignment are valid.
 439 // Return true if it is a bound-remapping so we can perform further checks.
 440 static bool CheckPointerBounds(
 441     evaluate::FoldingContext &context, const evaluate::Assignment &assignment) {
 442   auto &messages{context.messages()};
 443   const SomeExpr &lhs{assignment.lhs};
 444   const SomeExpr &rhs{assignment.rhs};
 445   bool isBoundsRemapping{false};
 446   std::size_t numBounds{common::visit(
 447       common::visitors{
 448           [&](const evaluate::Assignment::BoundsSpec &bounds) {
 449             return bounds.size();
 450           },
 451           [&](const evaluate::Assignment::BoundsRemapping &bounds) {
 452             isBoundsRemapping = true;
 453             evaluate::ExtentExpr lhsSizeExpr{1};
 454             for (const auto &bound : bounds) {
 455               lhsSizeExpr = std::move(lhsSizeExpr) *
 456                   (common::Clone(bound.second) - common::Clone(bound.first) +
 457                       evaluate::ExtentExpr{1});
 458             }
 459             if (std::optional<std::int64_t> lhsSize{evaluate::ToInt64(
 460                     evaluate::Fold(context, std::move(lhsSizeExpr)))}) {
 461               if (auto shape{evaluate::GetShape(context, rhs)}) {
 462                 if (std::optional<std::int64_t> rhsSize{
 463                         evaluate::ToInt64(evaluate::Fold(
 464                             context, evaluate::GetSize(std::move(*shape))))}) {
 465                   if (*lhsSize > *rhsSize) {
 466                     messages.Say(
 467                         "Pointer bounds require %d elements but target has"
 468                         " only %d"_err_en_US,
 469                         *lhsSize, *rhsSize); // 10.2.2.3(9)
 470                   }
 471                 }
 472               }
 473             }
 474             return bounds.size();
 475           },
 476           [](const auto &) -> std::size_t {
 477             DIE("not valid for pointer assignment");
 478           },
 479       },
 480       assignment.u)};
 481   if (numBounds > 0) {
 482     if (lhs.Rank() != static_cast<int>(numBounds)) {
 483       messages.Say("Pointer '%s' has rank %d but the number of bounds specified"
 484                    " is %d"_err_en_US,
 485           lhs.AsFortran(), lhs.Rank(), numBounds); // C1018
 486     }
 487   }
 488   if (isBoundsRemapping && rhs.Rank() != 1 &&
 489       !evaluate::IsSimplyContiguous(rhs, context)) {
 490     messages.Say("Pointer bounds remapping target must have rank 1 or be"
 491                  " simply contiguous"_err_en_US); // 10.2.2.3(9)
 492   }
 493   return isBoundsRemapping;
 494 }
 495
 496 bool CheckPointerAssignment(SemanticsContext &context,
 497     const evaluate::Assignment &assignment, const Scope &scope) {
 498   return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
 499       CheckPointerBounds(context.foldingContext(), assignment),
 500       /*isAssumedRank=*/false);
 501 }
 502
 503 bool CheckPointerAssignment(SemanticsContext &context, const SomeExpr &lhs,
 504     const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping,
 505     bool isAssumedRank) {
 506   const Symbol *pointer{GetLastSymbol(lhs)};
 507   if (!pointer) {
 508     return false; // error was reported
 509   }
 510   PointerAssignmentChecker checker{context, scope, *pointer};
 511   checker.set_isBoundsRemapping(isBoundsRemapping);
 512   checker.set_isAssumedRank(isAssumedRank);
 513   bool lhsOk{checker.CheckLeftHandSide(lhs)};
 514   bool rhsOk{checker.Check(rhs)};
 515   return lhsOk && rhsOk; // don't short-circuit
 516 }
 517
 518 bool CheckStructConstructorPointerComponent(SemanticsContext &context,
 519     const Symbol &lhs, const SomeExpr &rhs, const Scope &scope) {
 520   return PointerAssignmentChecker{context, scope, lhs}
 521       .set_pointerComponentLHS(&lhs)
 522       .Check(rhs);
 523 }
 524
 525 bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
 526     const std::string &description, const DummyDataObject &lhs,
 527     const SomeExpr &rhs, const Scope &scope, bool isAssumedRank) {
 528   return PointerAssignmentChecker{context, scope, source, description}
 529       .set_lhsType(common::Clone(lhs.type))
 530       .set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
 531       .set_isVolatile(lhs.attrs.test(DummyDataObject::Attr::Volatile))
 532       .set_isAssumedRank(isAssumedRank)
 533       .Check(rhs);
 534 }
 535
 536 bool CheckInitialDataPointerTarget(SemanticsContext &context,
 537     const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
 538   return evaluate::IsInitialDataTarget(
 539              init, &context.foldingContext().messages()) &&
 540       CheckPointerAssignment(context, pointer, init, scope,
 541           /*isBoundsRemapping=*/false,
 542           /*isAssumedRank=*/false);
 543 }
 544
 545 } // namespace Fortran::semantics