[flang] Improve initializer semantics, esp. for component default values

This patch plugs many holes in static initializer semantics, improves error
messages for default initial values and other component properties in
parameterized derived type instantiations, and cleans up several small
issues noticed during development.  We now do proper scalar expansion,
folding, and type, rank, and shape conformance checking for component
default initializers in derived types and PDT instantiations.
The initial values of named constants are now guaranteed to have been folded
when installed in the symbol table, and are no longer folded or
scalar-expanded at each use in expression folding.  Semantics documentation
was extended with information about the various kinds of initializations
in Fortran and when each of them are processed in the compiler.

Some necessary concomitant changes have bulked this patch out a bit:
* contextual messages attachments, which are now produced for parameterized
  derived type instantiations so that the user can figure out which
  instance caused a problem with a component, have been added as part
  of ContextualMessages, and their implementation was debugged
* several APIs in evaluate::characteristics was changed so that a FoldingContext
  is passed as an argument rather than just its intrinsic procedure table;
  this affected client call sites in many files
* new tools in Evaluate/check-expression.cpp to determine when an Expr
  actually is a single constant value and to validate a non-pointer
  variable initializer or object component default value
* shape conformance checking has additional arguments that control
  whether scalar expansion is allowed
* several now-unused functions and data members noticed and removed
* several crashes and bogus errors exposed by testing this new code
  were fixed
* a -fdebug-stack-trace option to enable LLVM's stack tracing on
  a crash, which might be useful in the future

TL;DR: Initialization processing does more and takes place at the right
times for all of the various kinds of things that can be initialized.

Differential Review: https://reviews.llvm.org/D92783

Author: klausler

flang/docs/Semantics.md

@@ -147,6 +147,49 @@ By this phase, all names and expressions that can be successfully resolved
 have been. But there may be names without symbols or expressions without
 analyzed form if errors occurred earlier.
 
+### Initialization processing
+
+Fortran supports many means of specifying static initializers for variables,
+object pointers, and procedure pointers, as well as default initializers for
+derived type object components, pointers, and type parameters.
+
+Non-pointer static initializers of variables and named constants are
+scanned, analyzed, folded, scalar-expanded, and validated as they are
+traversed during declaration processing in name resolution.
+So are the default initializers of non-pointer object components in
+non-parameterized derived types.
+Name constant arrays with implied shapes take their actual shape from
+the initialization expression.
+
+Default initializers of non-pointer components and type parameters
+in distinct parameterized
+derived type instantiations are similarly processed as those instances
+are created, as their expressions may depend on the values of type
+parameters.
+Error messages produced during parameterized derived type instantiation
+are decorated with contextual attachments that point to the declarations
+or other type specifications that caused the instantiation.
+
+Static initializations in `DATA` statements are collected, validated,
+and converted into static initialization in the symbol table, as if
+the initialized objects had used the newer style of static initialization
+in their entity declarations.
+
+All statically initialized pointers, and default component initializers for
+pointers, are processed late in name resolution after all specification parts
+have been traversed.
+This allows for forward references even in the presence of `IMPLICIT NONE`.
+Object pointer initializers in parameterized derived type instantiations are
+also cloned and folded at this late stage.
+Validation of pointer initializers takes place later in declaration
+checking (below).
+
+### Declaration checking
+
+Whenever possible, the enforcement of constraints and "shalls" pertaining to
+properties of symbols is deferred to a single read-only pass over the symbol table
+that takes place after all name resolution and typing is complete.
+
 ### Write module files
 
 Separate compilation information is written out on successful compilation

flang/include/flang/Common/reference-counted.h

@@ -19,6 +19,7 @@ namespace Fortran::common {
 template <typename A> class ReferenceCounted {
 public:
   ReferenceCounted() {}
+  int references() const { return references_; }
   void TakeReference() { ++references_; }
   void DropReference() {
     if (--references_ == 0) {

flang/include/flang/Evaluate/characteristics.h

@@ -32,9 +32,6 @@ namespace llvm {
 class raw_ostream;
 }
 
-namespace Fortran::evaluate {
-class IntrinsicProcTable;
-}
 namespace Fortran::evaluate::characteristics {
 struct Procedure;
 }
@@ -82,7 +79,7 @@ class TypeAndShape {
   static std::optional<TypeAndShape> Characterize(
       const semantics::Symbol &, FoldingContext &);
   static std::optional<TypeAndShape> Characterize(
-      const semantics::ObjectEntityDetails &);
+      const semantics::ObjectEntityDetails &, FoldingContext &);
   static std::optional<TypeAndShape> Characterize(
       const semantics::ProcInterface &);
   static std::optional<TypeAndShape> Characterize(
@@ -160,7 +157,7 @@ class TypeAndShape {
       const semantics::AssocEntityDetails &, FoldingContext &);
   static std::optional<TypeAndShape> Characterize(
       const semantics::ProcEntityDetails &);
-  void AcquireShape(const semantics::ObjectEntityDetails &);
+  void AcquireShape(const semantics::ObjectEntityDetails &, FoldingContext &);
   void AcquireLEN();
 
 protected:
@@ -184,7 +181,8 @@ struct DummyDataObject {
   bool operator!=(const DummyDataObject &that) const {
     return !(*this == that);
   }
-  static std::optional<DummyDataObject> Characterize(const semantics::Symbol &);
+  static std::optional<DummyDataObject> Characterize(
+      const semantics::Symbol &, FoldingContext &);
   bool CanBePassedViaImplicitInterface() const;
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
   TypeAndShape type;
@@ -202,7 +200,7 @@ struct DummyProcedure {
   bool operator==(const DummyProcedure &) const;
   bool operator!=(const DummyProcedure &that) const { return !(*this == that); }
   static std::optional<DummyProcedure> Characterize(
-      const semantics::Symbol &, const IntrinsicProcTable &);
+      const semantics::Symbol &, FoldingContext &context);
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
   CopyableIndirection<Procedure> procedure;
   common::Intent intent{common::Intent::Default};
@@ -228,7 +226,7 @@ struct DummyArgument {
   bool operator==(const DummyArgument &) const;
   bool operator!=(const DummyArgument &that) const { return !(*this == that); }
   static std::optional<DummyArgument> Characterize(
-      const semantics::Symbol &, const IntrinsicProcTable &);
+      const semantics::Symbol &, FoldingContext &);
   static std::optional<DummyArgument> FromActual(
       std::string &&, const Expr<SomeType> &, FoldingContext &);
   bool IsOptional() const;
@@ -259,7 +257,7 @@ struct FunctionResult {
   bool operator==(const FunctionResult &) const;
   bool operator!=(const FunctionResult &that) const { return !(*this == that); }
   static std::optional<FunctionResult> Characterize(
-      const Symbol &, const IntrinsicProcTable &);
+      const Symbol &, FoldingContext &);
 
   bool IsAssumedLengthCharacter() const;
 
@@ -297,11 +295,11 @@ struct Procedure {
   // Characterizes the procedure represented by a symbol, which may be an
   // "unrestricted specific intrinsic function".
   static std::optional<Procedure> Characterize(
-      const semantics::Symbol &, const IntrinsicProcTable &);
+      const semantics::Symbol &, FoldingContext &);
   static std::optional<Procedure> Characterize(
-      const ProcedureDesignator &, const IntrinsicProcTable &);
+      const ProcedureDesignator &, FoldingContext &);
   static std::optional<Procedure> Characterize(
-      const ProcedureRef &, const IntrinsicProcTable &);
+      const ProcedureRef &, FoldingContext &);
 
   // At most one of these will return true.
   // For "EXTERNAL P" with no type for or calls to P, both will be false.

flang/include/flang/Evaluate/check-expression.h

@@ -24,7 +24,6 @@ class Scope;
 }
 
 namespace Fortran::evaluate {
-class IntrinsicProcTable;
 
 // Predicate: true when an expression is a constant expression (in the
 // strict sense of the Fortran standard); it may not (yet) be a hard
@@ -35,6 +34,12 @@ extern template bool IsConstantExpr(const Expr<SomeInteger> &);
 extern template bool IsConstantExpr(const Expr<SubscriptInteger> &);
 extern template bool IsConstantExpr(const StructureConstructor &);
 
+// Predicate: true when an expression actually is a typed Constant<T>,
+// perhaps with parentheses and wrapping around it.  False for all typeless
+// expressions, including BOZ literals.
+template <typename A> bool IsActuallyConstant(const A &);
+extern template bool IsActuallyConstant(const Expr<SomeType> &);
+
 // Checks whether an expression is an object designator with
 // constant addressing and no vector-valued subscript.
 // If a non-null ContextualMessages pointer is passed, an error message
@@ -46,38 +51,44 @@ bool IsInitialProcedureTarget(const Symbol &);
 bool IsInitialProcedureTarget(const ProcedureDesignator &);
 bool IsInitialProcedureTarget(const Expr<SomeType> &);
 
+// Validate the value of a named constant, the static initial
+// value of a non-pointer non-allocatable non-dummy variable, or the
+// default initializer of a component of a derived type (or instantiation
+// of a derived type).  Converts type and expands scalars as necessary.
+std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &,
+    Expr<SomeType> &&, FoldingContext &,
+    const semantics::Scope *instantiation = nullptr);
+
 // Check whether an expression is a specification expression
 // (10.1.11(2), C1010).  Constant expressions are always valid
 // specification expressions.
 
 template <typename A>
-void CheckSpecificationExpr(const A &, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &);
-extern template void CheckSpecificationExpr(const Expr<SomeType> &x,
-    parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &);
-extern template void CheckSpecificationExpr(const Expr<SomeInteger> &x,
-    parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &);
+void CheckSpecificationExpr(
+    const A &, const semantics::Scope &, FoldingContext &);
+extern template void CheckSpecificationExpr(
+    const Expr<SomeType> &x, const semantics::Scope &, FoldingContext &);
+extern template void CheckSpecificationExpr(
+    const Expr<SomeInteger> &x, const semantics::Scope &, FoldingContext &);
 extern template void CheckSpecificationExpr(const Expr<SubscriptInteger> &x,
-    parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &);
+    const semantics::Scope &, FoldingContext &);
 extern template void CheckSpecificationExpr(
-    const std::optional<Expr<SomeType>> &x, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &);
+    const std::optional<Expr<SomeType>> &x, const semantics::Scope &,
+    FoldingContext &);
 extern template void CheckSpecificationExpr(
-    const std::optional<Expr<SomeInteger>> &x, parser::ContextualMessages &,
-    const semantics::Scope &, const IntrinsicProcTable &);
+    const std::optional<Expr<SomeInteger>> &x, const semantics::Scope &,
+    FoldingContext &);
 extern template void CheckSpecificationExpr(
-    const std::optional<Expr<SubscriptInteger>> &x,
-    parser::ContextualMessages &, const semantics::Scope &,
-    const IntrinsicProcTable &);
+    const std::optional<Expr<SubscriptInteger>> &x, const semantics::Scope &,
+    FoldingContext &);
 
 // Simple contiguity (9.5.4)
-template <typename A>
-bool IsSimplyContiguous(const A &, const IntrinsicProcTable &);
+template <typename A> bool IsSimplyContiguous(const A &, FoldingContext &);
 extern template bool IsSimplyContiguous(
-    const Expr<SomeType> &, const IntrinsicProcTable &);
+    const Expr<SomeType> &, FoldingContext &);
+
+template <typename A> bool IsErrorExpr(const A &);
+extern template bool IsErrorExpr(const Expr<SomeType> &);
 
 } // namespace Fortran::evaluate
 #endif

flang/include/flang/Evaluate/common.h

@@ -236,7 +236,7 @@ class FoldingContext {
   bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; }
   bool bigEndian() const { return bigEndian_; }
   const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; }
-  const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
+  const IntrinsicProcTable &intrinsics() const { return intrinsics_; }
 
   ConstantSubscript &StartImpliedDo(parser::CharBlock, ConstantSubscript = 1);
   std::optional<ConstantSubscript> GetImpliedDo(parser::CharBlock) const;

flang/include/flang/Evaluate/shape.h

@@ -210,7 +210,8 @@ std::optional<ConstantSubscripts> GetConstantExtents(
 // are known.
 bool CheckConformance(parser::ContextualMessages &, const Shape &left,
     const Shape &right, const char *leftIs = "left operand",
-    const char *rightIs = "right operand");
+    const char *rightIs = "right operand", bool leftScalarExpandable = true,
+    bool rightScalarExpandable = true);
 
 // Increments one-based subscripts in element order (first varies fastest)
 // and returns true when they remain in range; resets them all to one and

flang/include/flang/Evaluate/tools.h

@@ -233,7 +233,11 @@ bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = false) {
     while (const Component * component{std::get_if<Component>(&ref->u)}) {
       ref = &component->base();
     }
-    return std::holds_alternative<ArrayRef>(ref->u);
+    if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
+      return !coarrayRef->subscript().empty();
+    } else {
+      return std::holds_alternative<ArrayRef>(ref->u);
+    }
   } else {
     return false;
   }
@@ -830,9 +834,9 @@ parser::Message *SayWithDeclaration(
 // Check for references to impure procedures; returns the name
 // of one to complain about, if any exist.
 std::optional<std::string> FindImpureCall(
-    const IntrinsicProcTable &, const Expr<SomeType> &);
+    FoldingContext &, const Expr<SomeType> &);
 std::optional<std::string> FindImpureCall(
-    const IntrinsicProcTable &, const ProcedureRef &);
+    FoldingContext &, const ProcedureRef &);
 
 // Predicate: is a scalar expression suitable for naive scalar expansion
 // in the flattening of an array expression?
@@ -857,6 +861,41 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
     const std::optional<characteristics::Procedure> &lhsProcedure,
     const characteristics::Procedure *rhsProcedure);
 
+// Scalar constant expansion
+class ScalarConstantExpander {
+public:
+  explicit ScalarConstantExpander(ConstantSubscripts &&extents)
+      : extents_{std::move(extents)} {}
+  ScalarConstantExpander(
+      ConstantSubscripts &&extents, std::optional<ConstantSubscripts> &&lbounds)
+      : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
+  ScalarConstantExpander(
+      ConstantSubscripts &&extents, ConstantSubscripts &&lbounds)
+      : extents_{std::move(extents)}, lbounds_{std::move(lbounds)} {}
+
+  template <typename A> A Expand(A &&x) const {
+    return std::move(x); // default case
+  }
+  template <typename T> Constant<T> Expand(Constant<T> &&x) {
+    auto expanded{x.Reshape(std::move(extents_))};
+    if (lbounds_) {
+      expanded.set_lbounds(std::move(*lbounds_));
+    }
+    return expanded;
+  }
+  template <typename T> Constant<T> Expand(Parentheses<T> &&x) {
+    return Expand(std::move(x)); // Constant<> can be parenthesized
+  }
+  template <typename T> Expr<T> Expand(Expr<T> &&x) {
+    return std::visit([&](auto &&x) { return Expr<T>{Expand(std::move(x))}; },
+        std::move(x.u));
+  }
+
+private:
+  ConstantSubscripts extents_;
+  std::optional<ConstantSubscripts> lbounds_;
+};
+
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
@@ -875,6 +914,8 @@ bool IsProcedurePointer(const Symbol &);
 bool IsSaved(const Symbol &); // saved implicitly or explicitly
 bool IsDummy(const Symbol &);
 bool IsFunctionResult(const Symbol &);
+bool IsKindTypeParameter(const Symbol &);
+bool IsLenTypeParameter(const Symbol &);
 
 // Follow use, host, and construct assocations to a variable, if any.
 const Symbol *GetAssociationRoot(const Symbol &);

flang/include/flang/Evaluate/type.h

@@ -421,9 +421,6 @@ int SelectedIntKind(std::int64_t precision = 0);
 int SelectedRealKind(
     std::int64_t precision = 0, std::int64_t range = 0, std::int64_t radix = 2);
 
-// Utilities
-bool IsKindTypeParameter(const semantics::Symbol &);
-
 // For generating "[extern] template class", &c. boilerplate
 #define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \
   M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16)

flang/include/flang/Parser/message.h

@@ -255,6 +255,7 @@ class ContextualMessages {
 
   CharBlock at() const { return at_; }
   Messages *messages() const { return messages_; }
+  Message::Reference contextMessage() const { return contextMessage_; }
   bool empty() const { return !messages_ || messages_->empty(); }
 
   // Set CharBlock for messages; restore when the returned value is deleted
@@ -265,6 +266,13 @@ class ContextualMessages {
     return common::ScopedSet(at_, std::move(at));
   }
 
+  common::Restorer<Message::Reference> SetContext(Message *m) {
+    if (!m) {
+      m = contextMessage_.get();
+    }
+    return common::ScopedSet(contextMessage_, m);
+  }
+
   // Diverts messages to another buffer; restored when the returned
   // value is deleted.
   common::Restorer<Messages *> SetMessages(Messages &buffer) {
@@ -277,7 +285,11 @@ class ContextualMessages {
 
   template <typename... A> Message *Say(CharBlock at, A &&...args) {
     if (messages_ != nullptr) {
-      return &messages_->Say(at, std::forward<A>(args)...);
+      auto &msg{messages_->Say(at, std::forward<A>(args)...)};
+      if (contextMessage_) {
+        msg.SetContext(contextMessage_.get());
+      }
+      return &msg;
     } else {
       return nullptr;
     }
@@ -290,6 +302,7 @@ class ContextualMessages {
 private:
   CharBlock at_;
   Messages *messages_{nullptr};
+  Message::Reference contextMessage_;
 };
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_MESSAGE_H_