[flang] Improve handling of NULL pointers when folding components of named constants

[klausler]

Summary

When a component reference to a named constant of derived type should
fold down to NULL() without a MOLD=, do so.

flang/include/flang/Evaluate/tools.h

 bool IsAllocatableOrPointerObject(const Expr<SomeType> &, FoldingContext &);
 
 bool IsAllocatableDesignator(const Expr<SomeType> &);
 
 // Procedure and pointer detection predicates
 bool IsProcedure(const Expr<SomeType> &);
 bool IsFunction(const Expr<SomeType> &);
 bool IsProcedurePointerTarget(const Expr<SomeType> &);
-bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD=
+bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
 bool IsNullObjectPointer(const Expr<SomeType> &);
 bool IsNullProcedurePointer(const Expr<SomeType> &);
 bool IsNullPointer(const Expr<SomeType> &);
 bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
 
 // Can Expr be passed as absent to an optional dummy argument.
 // See 15.5.2.12 point 1 for more details.
 bool MayBePassedAsAbsentOptional(const Expr<SomeType> &, FoldingContext &);

flang/lib/Evaluate/fold.cpp

 Expr<SomeDerived> FoldOperation(
     FoldingContext &context, StructureConstructor &&structure) {
   StructureConstructor ctor{structure.derivedTypeSpec()};
   bool isConstant{true};
   auto restorer{context.WithPDTInstance(structure.derivedTypeSpec())};
   for (auto &&[symbol, value] : std::move(structure)) {
     auto expr{Fold(context, std::move(value.value()))};
     if (IsPointer(symbol)) {
-      if (IsProcedure(symbol)) {
+      if (IsNullPointer(expr)) {
+        // Handle x%c when x designates a named constant of derived
+        // type and %c is NULL() in that constant.
+        expr = Expr<SomeType>{NullPointer{}};
+      } else if (IsProcedure(symbol)) {
         isConstant &= IsInitialProcedureTarget(expr);
       } else {
         isConstant &= IsInitialDataTarget(expr);
       }
     } else {
       isConstant &= IsActuallyConstant(expr);
       if (auto valueShape{GetConstantExtents(context, expr)}) {
         if (auto componentShape{GetConstantExtents(context, symbol)}) {

flang/lib/Evaluate/tools.cpp

if (IsNullObjectPointer(expr)) {
     return IsVariable(*funcRef);
   } else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
     return IsPointer(symbol->GetUltimate());
   } else {
     return false;
   }
 }
 
-bool IsBareNullPointer(const Expr<SomeType> *expr) {
-  return expr && std::holds_alternative<NullPointer>(expr->u);
-}
+// IsNullPointer() & variations
 
-// IsNullObjectPointetr, IsNullProcedurePointer(), IsNullPointer()
 template <bool IS_PROC_PTR> struct IsNullPointerHelper {
   template <typename A> bool operator()(const A &) const { return false; }
   bool operator()(const ProcedureRef &call) const {
     if constexpr (IS_PROC_PTR) {
       const auto *intrinsic{call.proc().GetSpecificIntrinsic()};
       return intrinsic &&
           intrinsic->characteristics.value().attrs.test(
               characteristics::Procedure::Attr::NullPointer);
     } else {
       return false;
     }
   }
   template <typename T> bool operator()(const FunctionRef<T> &call) const {
     if constexpr (IS_PROC_PTR) {
       return false;
     } else {
       const auto *intrinsic{call.proc().GetSpecificIntrinsic()};
       return intrinsic &&
           intrinsic->characteristics.value().attrs.test(
               characteristics::Procedure::Attr::NullPointer);
     }
   }
+  template <typename T> bool operator()(const Designator<T> &x) const {
+    if (const auto *component{std::get_if<Component>(&x.u)}) {
+      if (const auto *baseSym{std::get_if<SymbolRef>(&component->base().u)}) {
+        const Symbol &base{**baseSym};
+        if (const auto *object{
+                base.detailsIf<semantics::ObjectEntityDetails>()}) {
+          // TODO: nested component and array references
+          if (IsNamedConstant(base) && object->init()) {
+            if (auto structCons{
+                    GetScalarConstantValue<SomeDerived>(*object->init())}) {
+              auto iter{structCons->values().find(component->GetLastSymbol())};
+              if (iter != structCons->values().end()) {
+                return (*this)(iter->second.value());
+              }
+            }
+          }
+        }
+      }
+    }
+    return false;
+  }
   bool operator()(const NullPointer &) const { return true; }
   template <typename T> bool operator()(const Parentheses<T> &x) const {
     return (*this)(x.left());
   }
   template <typename T> bool operator()(const Expr<T> &x) const {
     return common::visit(*this, x.u);
   }
 };
 
 bool IsNullObjectPointer(const Expr<SomeType> &expr) {
   return IsNullPointerHelper<false>{}(expr);
 }
+
 bool IsNullProcedurePointer(const Expr<SomeType> &expr) {
   return IsNullPointerHelper<true>{}(expr);
 }
+
 bool IsNullPointer(const Expr<SomeType> &expr) {
   return IsNullObjectPointer(expr) || IsNullProcedurePointer(expr);
 }
 
+bool IsBareNullPointer(const Expr<SomeType> *expr) {
+  return expr && std::holds_alternative<NullPointer>(expr->u);
+}
+
 // GetSymbolVector()
 auto GetSymbolVectorHelper::operator()(const Symbol &x) const -> Result {
   if (const auto *details{x.detailsIf<semantics::AssocEntityDetails>()}) {
     return (*this)(details->expr());
   } else {
     return {x.GetUltimate()};
   }
 }