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