[flang] Don't compute pointer component procedure characteristics when not needed

[klausler]

Summary

When a procedure pointer component has an interface that is a forward
reference to a procedure, syntax errors can be emitted if there is
a structure constructor that tries to initialize that component,
since its characteristics are not yet known; however, when the
initializer is a bare NULL(with no mold), those characteristics
don't matter. Make the characterization of the procedure pointer
component take place only when needed.

flang/lib/Semantics/pointer-assignment.cpp

PointerAssignmentChecker(evaluate::FoldingContext &context,
       parser::CharBlock source, const std::string &description)
       : context_{context}, source_{source}, description_{description} {}
   PointerAssignmentChecker(evaluate::FoldingContext &context, const Symbol &lhs)
       : context_{context}, source_{lhs.name()},
         description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
     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<TypeAndShape> &&);
   PointerAssignmentChecker &set_isContiguous(bool);
   PointerAssignmentChecker &set_isVolatile(bool);
   PointerAssignmentChecker &set_isBoundsRemapping(bool);
   bool Check(const SomeExpr &);
 
 private:
+  bool CharacterizeProcedure();
   template <typename T> bool Check(const T &);
   template <typename T> bool Check(const evaluate::Expr<T> &);
   template <typename T> bool Check(const evaluate::FunctionRef<T> &);
   template <typename T> bool Check(const evaluate::Designator<T> &);
   bool Check(const evaluate::NullPointer &);
   bool Check(const evaluate::ProcedureDesignator &);
   bool Check(const evaluate::ProcedureRef &);
   // Target is a procedure
   bool Check(parser::CharBlock rhsName, bool isCall,
       const Procedure * = nullptr,
       const evaluate::SpecificIntrinsic *specific = nullptr);
   bool LhsOkForUnlimitedPoly() const;
   template <typename... A> parser::Message *Say(A &&...);
 
   evaluate::FoldingContext &context_;
   const parser::CharBlock source_;
   const std::string description_;
   const Symbol *lhs_{nullptr};
   std::optional<TypeAndShape> lhsType_;
   std::optional<Procedure> procedure_;
+  bool characterizedProcedure_{false};
   bool isContiguous_{false};
   bool isVolatile_{false};
   bool isBoundsRemapping_{false};
 };
 
 PointerAssignmentChecker &PointerAssignmentChecker::set_lhsType(
     std::optional<TypeAndShape> &&lhsType) {
   lhsType_ = std::move(lhsType);

 }
 
 PointerAssignmentChecker &PointerAssignmentChecker::set_isBoundsRemapping(
     bool isBoundsRemapping) {
   isBoundsRemapping_ = isBoundsRemapping;
   return *this;
 }
 
+bool PointerAssignmentChecker::CharacterizeProcedure() {
+  if (!characterizedProcedure_) {
+    characterizedProcedure_ = true;
+    if (lhs_ && IsProcedure(*lhs_)) {
+      procedure_ = Procedure::Characterize(*lhs_, context_);
+    }
+  }
+  return procedure_.has_value();
+}
+
 template <typename T> 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"
       " pointer-valued function"_err_en_US,
       description_);
   return false;
 }
 
bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
   if (!proc) {
     return false;
   }
   std::optional<MessageFixedText> msg;
   const auto &funcResult{proc->functionResult}; // C1025
   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;
   } else if (funcResult->IsProcedurePointer()) {
     msg = "Object %s is associated with the result of a reference to"
           " function '%s' that is a procedure pointer"_err_en_US;
   } else if (!funcResult->attrs.test(FunctionResult::Attr::Pointer)) {
     msg = "%s is associated with the result of a reference to function '%s'"
bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
   const Symbol *last{d.GetLastSymbol()};
   const Symbol *base{d.GetBaseObject().symbol()};
   if (!last || !base) {
     // P => "character literal"(1:3)
     context_.messages().Say("Pointer target is not a named entity"_err_en_US);
     return false;
   }
   std::optional<std::variant<MessageFixedText, MessageFormattedText>> 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;
   } else if (!evaluate::GetLastTarget(GetSymbolVector(d))) { // C1025
     msg = "In assignment to object %s, the target '%s' is not an object with"
           " POINTER or TARGET attributes"_err_en_US;
   } else if (auto rhsType{TypeAndShape::Characterize(d, context_)}) {
     if (!lhsType_) {
bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
   return true;
 }
 
 // Common handling for procedure pointer right-hand sides
 bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
     const Procedure *rhsProcedure,
     const evaluate::SpecificIntrinsic *specific) {
   std::string whyNot;
+  CharacterizeProcedure();
   if (std::optional<MessageFixedText> msg{evaluate::CheckProcCompatibility(
           isCall, procedure_, rhsProcedure, specific, whyNot)}) {
     Say(std::move(*msg), description_, rhsName, whyNot);
     return false;
   }
   return true;
 }