diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -48,9 +48,6 @@ set_lhsType(TypeAndShape::Characterize(lhs, context)); set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS)); set_isVolatile(lhs.attrs().test(Attr::VOLATILE)); - if (IsProcedure(lhs)) { - procedure_ = Procedure::Characterize(lhs, context); - } } PointerAssignmentChecker &set_lhsType(std::optional &&); PointerAssignmentChecker &set_isContiguous(bool); @@ -59,6 +56,7 @@ bool Check(const SomeExpr &); private: + bool CharacterizeProcedure(); template bool Check(const T &); template bool Check(const evaluate::Expr &); template bool Check(const evaluate::FunctionRef &); @@ -79,6 +77,7 @@ const Symbol *lhs_{nullptr}; std::optional lhsType_; std::optional procedure_; + bool characterizedProcedure_{false}; bool isContiguous_{false}; bool isVolatile_{false}; bool isBoundsRemapping_{false}; @@ -108,6 +107,16 @@ return *this; } +bool PointerAssignmentChecker::CharacterizeProcedure() { + if (!characterizedProcedure_) { + characterizedProcedure_ = true; + if (lhs_ && IsProcedure(*lhs_)) { + procedure_ = Procedure::Characterize(*lhs_, context_); + } + } + return procedure_.has_value(); +} + template bool PointerAssignmentChecker::Check(const T &) { // Catch-all case for really bad target expression Say("Target associated with %s must be a designator or a call to a" @@ -155,7 +164,7 @@ if (!funcResult) { msg = "%s is associated with the non-existent result of reference to" " procedure"_err_en_US; - } else if (procedure_) { + } else if (CharacterizeProcedure()) { // Shouldn't be here in this function unless lhs is an object pointer. msg = "Procedure %s is associated with the result of a reference to" " function '%s' that does not return a procedure pointer"_err_en_US; @@ -197,7 +206,7 @@ return false; } std::optional> msg; - if (procedure_) { + if (CharacterizeProcedure()) { // Shouldn't be here in this function unless lhs is an object pointer. msg = "In assignment to procedure %s, the target is not a procedure or" " procedure pointer"_err_en_US; @@ -260,6 +269,7 @@ const Procedure *rhsProcedure, const evaluate::SpecificIntrinsic *specific) { std::string whyNot; + CharacterizeProcedure(); if (std::optional msg{evaluate::CheckProcCompatibility( isCall, procedure_, rhsProcedure, specific, whyNot)}) { Say(std::move(*msg), description_, rhsName, whyNot);