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