diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 7daeeba507f6..75cf4fe53664 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -1,480 +1,488 @@
 //===-- include/flang/Semantics/expression.h --------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_SEMANTICS_EXPRESSION_H_
 #define FORTRAN_SEMANTICS_EXPRESSION_H_
 
 #include "semantics.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/indirection.h"
+#include "flang/Common/restorer.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Evaluate/type.h"
 #include "flang/Parser/char-block.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/tools.h"
 #include <map>
 #include <optional>
 #include <type_traits>
 #include <variant>
 
 using namespace Fortran::parser::literals;
 
 namespace Fortran::parser {
 struct SourceLocationFindingVisitor {
   template <typename A> bool Pre(const A &x) {
     if constexpr (HasSource<A>::value) {
       source.ExtendToCover(x.source);
       return false;
     } else {
       return true;
     }
   }
   template <typename A> void Post(const A &) {}
   void Post(const CharBlock &at) { source.ExtendToCover(at); }
 
   CharBlock source;
 };
 
 template <typename A> CharBlock FindSourceLocation(const A &x) {
   SourceLocationFindingVisitor visitor;
   Walk(x, visitor);
   return visitor.source;
 }
 } // namespace Fortran::parser
 
 using namespace Fortran::parser::literals;
 
 // The expression semantic analysis code has its implementation in
 // namespace Fortran::evaluate, but the exposed API to it is in the
 // namespace Fortran::semantics (below).
 //
 // The ExpressionAnalyzer wraps a SemanticsContext reference
 // and implements constraint checking on expressions using the
 // parse tree node wrappers that mirror the grammar annotations used
 // in the Fortran standard (i.e., scalar-, constant-, &c.).
 
 namespace Fortran::evaluate {
 
 class IntrinsicProcTable;
 
 struct SetExprHelper {
   explicit SetExprHelper(GenericExprWrapper &&expr) : expr_{std::move(expr)} {}
   void Set(parser::TypedExpr &x) {
     x.Reset(new GenericExprWrapper{std::move(expr_)},
         evaluate::GenericExprWrapper::Deleter);
   }
   void Set(const parser::Expr &x) { Set(x.typedExpr); }
   void Set(const parser::Variable &x) { Set(x.typedExpr); }
   void Set(const parser::DataStmtConstant &x) { Set(x.typedExpr); }
   template <typename T> void Set(const common::Indirection<T> &x) {
     Set(x.value());
   }
   template <typename T> void Set(const T &x) {
     if constexpr (ConstraintTrait<T>) {
       Set(x.thing);
     } else if constexpr (WrapperTrait<T>) {
       Set(x.v);
     }
   }
 
   GenericExprWrapper expr_;
 };
 
 template <typename T> void ResetExpr(const T &x) {
   SetExprHelper{GenericExprWrapper{/* error indicator */}}.Set(x);
 }
 
 template <typename T> void SetExpr(const T &x, Expr<SomeType> &&expr) {
   SetExprHelper{GenericExprWrapper{std::move(expr)}}.Set(x);
 }
 
 class ExpressionAnalyzer {
 public:
   using MaybeExpr = std::optional<Expr<SomeType>>;
 
   explicit ExpressionAnalyzer(semantics::SemanticsContext &sc) : context_{sc} {}
   ExpressionAnalyzer(semantics::SemanticsContext &sc, FoldingContext &fc)
       : context_{sc}, foldingContext_{fc} {}
   ExpressionAnalyzer(ExpressionAnalyzer &) = default;
 
   semantics::SemanticsContext &context() const { return context_; }
 
   FoldingContext &GetFoldingContext() const { return foldingContext_; }
 
   parser::ContextualMessages &GetContextualMessages() {
     return foldingContext_.messages();
   }
 
   template <typename... A> parser::Message *Say(A &&...args) {
     return GetContextualMessages().Say(std::forward<A>(args)...);
   }
 
   template <typename T, typename... A>
   parser::Message *SayAt(const T &parsed, A &&...args) {
     return Say(parser::FindSourceLocation(parsed), std::forward<A>(args)...);
   }
 
   int GetDefaultKind(common::TypeCategory);
   DynamicType GetDefaultKindOfType(common::TypeCategory);
 
   // Return false and emit error if these checks fail:
   bool CheckIntrinsicKind(TypeCategory, std::int64_t kind);
   bool CheckIntrinsicSize(TypeCategory, std::int64_t size);
 
   // Manage a set of active implied DO loops.
   bool AddImpliedDo(parser::CharBlock, int kind);
   void RemoveImpliedDo(parser::CharBlock);
 
   // When the argument is the name of an active implied DO index, returns
   // its INTEGER kind type parameter.
   std::optional<int> IsImpliedDo(parser::CharBlock) const;
 
+  // Allows a whole assumed-size array to appear for the lifetime of
+  // the returned value.
+  common::Restorer<bool> AllowWholeAssumedSizeArray() {
+    return common::ScopedSet(isWholeAssumedSizeArrayOk_, true);
+  }
+
   Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
       const std::optional<parser::KindSelector> &);
 
   MaybeExpr Analyze(const parser::Expr &);
   MaybeExpr Analyze(const parser::Variable &);
   MaybeExpr Analyze(const parser::Designator &);
   MaybeExpr Analyze(const parser::DataStmtValue &);
 
   template <typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
     return Analyze(x.value());
   }
   template <typename A> MaybeExpr Analyze(const std::optional<A> &x) {
     if (x) {
       return Analyze(*x);
     } else {
       return std::nullopt;
     }
   }
 
   // Implement constraint-checking wrappers from the Fortran grammar.
   template <typename A> MaybeExpr Analyze(const parser::Scalar<A> &x) {
     auto result{Analyze(x.thing)};
     if (result) {
       if (int rank{result->Rank()}; rank != 0) {
         SayAt(x, "Must be a scalar value, but is a rank-%d array"_err_en_US,
             rank);
         ResetExpr(x);
         return std::nullopt;
       }
     }
     return result;
   }
   template <typename A> MaybeExpr Analyze(const parser::Constant<A> &x) {
     auto restorer{
         GetFoldingContext().messages().SetLocation(FindSourceLocation(x))};
     auto result{Analyze(x.thing)};
     if (result) {
       *result = Fold(std::move(*result));
       if (!IsConstantExpr(*result)) { //  C886, C887, C713
         SayAt(x, "Must be a constant value"_err_en_US);
         ResetExpr(x);
         return std::nullopt;
       } else {
         // Save folded expression for later use
         SetExpr(x, common::Clone(*result));
       }
     }
     return result;
   }
   template <typename A> MaybeExpr Analyze(const parser::Integer<A> &x) {
     auto result{Analyze(x.thing)};
     if (!EnforceTypeConstraint(
             parser::FindSourceLocation(x), result, TypeCategory::Integer)) {
       ResetExpr(x);
       return std::nullopt;
     }
     return result;
   }
   template <typename A> MaybeExpr Analyze(const parser::Logical<A> &x) {
     auto result{Analyze(x.thing)};
     if (!EnforceTypeConstraint(
             parser::FindSourceLocation(x), result, TypeCategory::Logical)) {
       ResetExpr(x);
       return std::nullopt;
     }
     return result;
   }
   template <typename A> MaybeExpr Analyze(const parser::DefaultChar<A> &x) {
     auto result{Analyze(x.thing)};
     if (!EnforceTypeConstraint(parser::FindSourceLocation(x), result,
             TypeCategory::Character, true /* default kind */)) {
       ResetExpr(x);
       return std::nullopt;
     }
     return result;
   }
 
   MaybeExpr Analyze(const parser::Name &);
   MaybeExpr Analyze(const parser::DataRef &dr) {
     return Analyze<parser::DataRef>(dr);
   }
   MaybeExpr Analyze(const parser::StructureComponent &);
   MaybeExpr Analyze(const parser::SignedIntLiteralConstant &);
   MaybeExpr Analyze(const parser::SignedRealLiteralConstant &);
   MaybeExpr Analyze(const parser::SignedComplexLiteralConstant &);
   MaybeExpr Analyze(const parser::StructureConstructor &);
   MaybeExpr Analyze(const parser::InitialDataTarget &);
 
   void Analyze(const parser::CallStmt &);
   const Assignment *Analyze(const parser::AssignmentStmt &);
   const Assignment *Analyze(const parser::PointerAssignmentStmt &);
 
 protected:
   int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
 
 private:
   MaybeExpr Analyze(const parser::IntLiteralConstant &);
   MaybeExpr Analyze(const parser::RealLiteralConstant &);
   MaybeExpr Analyze(const parser::ComplexPart &);
   MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
   MaybeExpr Analyze(const parser::LogicalLiteralConstant &);
   MaybeExpr Analyze(const parser::CharLiteralConstant &);
   MaybeExpr Analyze(const parser::HollerithLiteralConstant &);
   MaybeExpr Analyze(const parser::BOZLiteralConstant &);
   MaybeExpr Analyze(const parser::NamedConstant &);
   MaybeExpr Analyze(const parser::NullInit &);
   MaybeExpr Analyze(const parser::DataStmtConstant &);
   MaybeExpr Analyze(const parser::Substring &);
   MaybeExpr Analyze(const parser::ArrayElement &);
   MaybeExpr Analyze(const parser::CoindexedNamedObject &);
   MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
   MaybeExpr Analyze(const parser::ArrayConstructor &);
   MaybeExpr Analyze(const parser::FunctionReference &,
       std::optional<parser::StructureConstructor> * = nullptr);
   MaybeExpr Analyze(const parser::Expr::Parentheses &);
   MaybeExpr Analyze(const parser::Expr::UnaryPlus &);
   MaybeExpr Analyze(const parser::Expr::Negate &);
   MaybeExpr Analyze(const parser::Expr::NOT &);
   MaybeExpr Analyze(const parser::Expr::PercentLoc &);
   MaybeExpr Analyze(const parser::Expr::DefinedUnary &);
   MaybeExpr Analyze(const parser::Expr::Power &);
   MaybeExpr Analyze(const parser::Expr::Multiply &);
   MaybeExpr Analyze(const parser::Expr::Divide &);
   MaybeExpr Analyze(const parser::Expr::Add &);
   MaybeExpr Analyze(const parser::Expr::Subtract &);
   MaybeExpr Analyze(const parser::Expr::ComplexConstructor &);
   MaybeExpr Analyze(const parser::Expr::Concat &);
   MaybeExpr Analyze(const parser::Expr::LT &);
   MaybeExpr Analyze(const parser::Expr::LE &);
   MaybeExpr Analyze(const parser::Expr::EQ &);
   MaybeExpr Analyze(const parser::Expr::NE &);
   MaybeExpr Analyze(const parser::Expr::GE &);
   MaybeExpr Analyze(const parser::Expr::GT &);
   MaybeExpr Analyze(const parser::Expr::AND &);
   MaybeExpr Analyze(const parser::Expr::OR &);
   MaybeExpr Analyze(const parser::Expr::EQV &);
   MaybeExpr Analyze(const parser::Expr::NEQV &);
   MaybeExpr Analyze(const parser::Expr::DefinedBinary &);
   template <typename A> MaybeExpr Analyze(const A &x) {
     return Analyze(x.u); // default case
   }
   template <typename... As> MaybeExpr Analyze(const std::variant<As...> &u) {
     return std::visit(
         [&](const auto &x) {
           using Ty = std::decay_t<decltype(x)>;
           // Function references might turn out to be misparsed structure
           // constructors; we have to try generic procedure resolution
           // first to be sure.
           if constexpr (common::IsTypeInList<parser::StructureConstructor,
                             As...>) {
             std::optional<parser::StructureConstructor> ctor;
             MaybeExpr result;
             if constexpr (std::is_same_v<Ty,
                               common::Indirection<parser::FunctionReference>>) {
               result = Analyze(x.value(), &ctor);
             } else if constexpr (std::is_same_v<Ty,
                                      parser::FunctionReference>) {
               result = Analyze(x, &ctor);
             } else {
               return Analyze(x);
             }
             if (ctor) {
               // A misparsed function reference is really a structure
               // constructor.  Repair the parse tree in situ.
               const_cast<std::variant<As...> &>(u) = std::move(*ctor);
             }
             return result;
           }
           return Analyze(x);
         },
         u);
   }
 
   // Analysis subroutines
   int AnalyzeKindParam(
       const std::optional<parser::KindParam> &, int defaultKind);
   template <typename PARSED> MaybeExpr ExprOrVariable(const PARSED &);
   template <typename PARSED> MaybeExpr IntLiteralConstant(const PARSED &);
   MaybeExpr AnalyzeString(std::string &&, int kind);
   std::optional<Expr<SubscriptInteger>> AsSubscript(MaybeExpr &&);
   std::optional<Expr<SubscriptInteger>> TripletPart(
       const std::optional<parser::Subscript> &);
   std::optional<Subscript> AnalyzeSectionSubscript(
       const parser::SectionSubscript &);
   std::vector<Subscript> AnalyzeSectionSubscripts(
       const std::list<parser::SectionSubscript> &);
   MaybeExpr Designate(DataRef &&);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
   MaybeExpr TopLevelChecks(DataRef &&);
   std::optional<Expr<SubscriptInteger>> GetSubstringBound(
       const std::optional<parser::ScalarIntExpr> &);
   MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
 
   struct CalleeAndArguments {
     // A non-component function reference may constitute a misparsed
     // structure constructor, in which case its derived type's Symbol
     // will appear here.
     std::variant<ProcedureDesignator, SymbolRef> u;
     ActualArguments arguments;
   };
 
   std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
       const parser::ProcComponentRef &, ActualArguments &&);
   std::optional<characteristics::Procedure> CheckCall(
       parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
   using AdjustActuals =
       std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
   bool ResolveForward(const Symbol &);
   const Symbol *ResolveGeneric(const Symbol &, const ActualArguments &,
       const AdjustActuals &, bool mightBeStructureConstructor = false);
   void EmitGenericResolutionError(const Symbol &);
   std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
       ActualArguments &&, bool isSubroutine = false,
       bool mightBeStructureConstructor = false);
   std::optional<CalleeAndArguments> GetCalleeAndArguments(
       const parser::ProcedureDesignator &, ActualArguments &&,
       bool isSubroutine, bool mightBeStructureConstructor = false);
 
   void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
   bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
       bool defaultKind = false);
   MaybeExpr MakeFunctionRef(
       parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
   MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
   template <typename T> T Fold(T &&expr) {
     return evaluate::Fold(foldingContext_, std::move(expr));
   }
 
   semantics::SemanticsContext &context_;
   FoldingContext &foldingContext_{context_.foldingContext()};
   std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
   bool fatalErrors_{false};
+  bool isWholeAssumedSizeArrayOk_{false};
   friend class ArgumentAnalyzer;
 };
 
 inline bool AreConformable(int leftRank, int rightRank) {
   return leftRank == 0 || rightRank == 0 || leftRank == rightRank;
 }
 
 template <typename L, typename R>
 bool AreConformable(const L &left, const R &right) {
   return AreConformable(left.Rank(), right.Rank());
 }
 
 template <typename L, typename R>
 void ConformabilityCheck(
     parser::ContextualMessages &context, const L &left, const R &right) {
   if (!AreConformable(left, right)) {
     context.Say("left operand has rank %d, right operand has rank %d"_err_en_US,
         left.Rank(), right.Rank());
   }
 }
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 
 // Semantic analysis of one expression, variable, or designator.
 template <typename A>
 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
     SemanticsContext &context, const A &expr) {
   return evaluate::ExpressionAnalyzer{context}.Analyze(expr);
 }
 
 // Semantic analysis of an intrinsic type's KIND parameter expression.
 evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
     SemanticsContext &, common::TypeCategory,
     const std::optional<parser::KindSelector> &);
 
 void AnalyzeCallStmt(SemanticsContext &, const parser::CallStmt &);
 const evaluate::Assignment *AnalyzeAssignmentStmt(
     SemanticsContext &, const parser::AssignmentStmt &);
 const evaluate::Assignment *AnalyzePointerAssignmentStmt(
     SemanticsContext &, const parser::PointerAssignmentStmt &);
 
 // Semantic analysis of all expressions in a parse tree, which becomes
 // decorated with typed representations for top-level expressions.
 class ExprChecker {
 public:
   explicit ExprChecker(SemanticsContext &);
 
   template <typename A> bool Pre(const A &) { return true; }
   template <typename A> void Post(const A &) {}
   bool Walk(const parser::Program &);
 
   bool Pre(const parser::Expr &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::Variable &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::DataStmtValue &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::DataImpliedDo &);
 
   bool Pre(const parser::CallStmt &x) {
     AnalyzeCallStmt(context_, x);
     return false;
   }
   bool Pre(const parser::AssignmentStmt &x) {
     AnalyzeAssignmentStmt(context_, x);
     return false;
   }
   bool Pre(const parser::PointerAssignmentStmt &x) {
     AnalyzePointerAssignmentStmt(context_, x);
     return false;
   }
 
   template <typename A> bool Pre(const parser::Scalar<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Constant<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Integer<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Logical<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::DefaultChar<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
 
 private:
   SemanticsContext &context_;
   evaluate::ExpressionAnalyzer exprAnalyzer_{context_};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_EXPRESSION_H_
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 0b765c72fdd7..090aae0af8cb 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -1,296 +1,291 @@
 //===-- lib/Semantics/assignment.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "assignment.h"
 #include "pointer-assignment.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/restorer.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/message.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include <optional>
 #include <set>
 #include <string>
 #include <type_traits>
 
 using namespace Fortran::parser::literals;
 
 namespace Fortran::semantics {
 
 class AssignmentContext {
 public:
   explicit AssignmentContext(SemanticsContext &context) : context_{context} {}
   AssignmentContext(AssignmentContext &&) = default;
   AssignmentContext(const AssignmentContext &) = delete;
   bool operator==(const AssignmentContext &x) const { return this == &x; }
 
   template <typename A> void PushWhereContext(const A &);
   void PopWhereContext();
   void Analyze(const parser::AssignmentStmt &);
   void Analyze(const parser::PointerAssignmentStmt &);
   void Analyze(const parser::ConcurrentControl &);
 
 private:
   bool CheckForPureContext(const SomeExpr &lhs, const SomeExpr &rhs,
       parser::CharBlock rhsSource, bool isPointerAssignment);
   void CheckShape(parser::CharBlock, const SomeExpr *);
   template <typename... A>
   parser::Message *Say(parser::CharBlock at, A &&...args) {
     return &context_.Say(at, std::forward<A>(args)...);
   }
   evaluate::FoldingContext &foldingContext() {
     return context_.foldingContext();
   }
 
   SemanticsContext &context_;
   int whereDepth_{0}; // number of WHEREs currently nested in
   // shape of masks in LHS of assignments in current WHERE:
   std::vector<std::optional<std::int64_t>> whereExtents_;
 };
 
 void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
   if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
     const SomeExpr &lhs{assignment->lhs};
     const SomeExpr &rhs{assignment->rhs};
     auto lhsLoc{std::get<parser::Variable>(stmt.t).GetSource()};
     auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
-    auto shape{evaluate::GetShape(foldingContext(), lhs)};
-    if (shape && !shape->empty() && !shape->back().has_value()) { // C1014
-      Say(lhsLoc,
-          "Left-hand side of assignment may not be a whole assumed-size array"_err_en_US);
-    }
     if (CheckForPureContext(lhs, rhs, rhsLoc, false)) {
       const Scope &scope{context_.FindScope(lhsLoc)};
       if (auto whyNot{WhyNotModifiable(lhsLoc, lhs, scope, true)}) {
         if (auto *msg{Say(lhsLoc,
                 "Left-hand side of assignment is not modifiable"_err_en_US)}) { // C1158
           msg->Attach(*whyNot);
         }
       }
     }
     if (whereDepth_ > 0) {
       CheckShape(lhsLoc, &lhs);
     }
   }
 }
 
 void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
   CHECK(whereDepth_ == 0);
   if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
     const SomeExpr &lhs{assignment->lhs};
     const SomeExpr &rhs{assignment->rhs};
     CheckForPureContext(lhs, rhs, std::get<parser::Expr>(stmt.t).source, true);
     auto restorer{
         foldingContext().messages().SetLocation(context_.location().value())};
     CheckPointerAssignment(foldingContext(), *assignment);
   }
 }
 
 // C1594 checks
 static bool IsPointerDummyOfPureFunction(const Symbol &x) {
   return IsPointerDummy(x) && FindPureProcedureContaining(x.owner()) &&
       x.owner().symbol() && IsFunction(*x.owner().symbol());
 }
 
 static const char *WhyBaseObjectIsSuspicious(
     const Symbol &x, const Scope &scope) {
   // See C1594, first paragraph.  These conditions enable checks on both
   // left-hand and right-hand sides in various circumstances.
   if (IsHostAssociated(x, scope)) {
     return "host-associated";
   } else if (IsUseAssociated(x, scope)) {
     return "USE-associated";
   } else if (IsPointerDummyOfPureFunction(x)) {
     return "a POINTER dummy argument of a pure function";
   } else if (IsIntentIn(x)) {
     return "an INTENT(IN) dummy argument";
   } else if (FindCommonBlockContaining(x)) {
     return "in a COMMON block";
   } else {
     return nullptr;
   }
 }
 
 // Checks C1594(1,2); false if check fails
 bool CheckDefinabilityInPureScope(parser::ContextualMessages &messages,
     const Symbol &lhs, const Scope &context, const Scope &pure) {
   if (pure.symbol()) {
     if (const char *why{WhyBaseObjectIsSuspicious(lhs, context)}) {
       evaluate::SayWithDeclaration(messages, lhs,
           "Pure subprogram '%s' may not define '%s' because it is %s"_err_en_US,
           pure.symbol()->name(), lhs.name(), why);
       return false;
     }
   }
   return true;
 }
 
 static std::optional<std::string> GetPointerComponentDesignatorName(
     const SomeExpr &expr) {
   if (const auto *derived{
           evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(expr))}) {
     UltimateComponentIterator ultimates{*derived};
     if (auto pointer{
             std::find_if(ultimates.begin(), ultimates.end(), IsPointer)}) {
       return pointer.BuildResultDesignatorName();
     }
   }
   return std::nullopt;
 }
 
 // Checks C1594(5,6); false if check fails
 bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
     const SomeExpr &expr, const Scope &scope) {
   if (const Symbol * base{GetFirstSymbol(expr)}) {
     if (const char *why{WhyBaseObjectIsSuspicious(*base, scope)}) {
       if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
         evaluate::SayWithDeclaration(messages, *base,
             "A pure subprogram may not copy the value of '%s' because it is %s"
             " and has the POINTER component '%s'"_err_en_US,
             base->name(), why, *pointer);
         return false;
       }
     }
   }
   return true;
 }
 
 bool AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
     const SomeExpr &rhs, parser::CharBlock source, bool isPointerAssignment) {
   const Scope &scope{context_.FindScope(source)};
   if (const Scope * pure{FindPureProcedureContaining(scope)}) {
     parser::ContextualMessages messages{
         context_.location().value(), &context_.messages()};
     if (evaluate::ExtractCoarrayRef(lhs)) {
       messages.Say(
           "A pure subprogram may not define a coindexed object"_err_en_US);
     } else if (const Symbol * base{GetFirstSymbol(lhs)}) {
       if (const auto *assoc{base->detailsIf<AssocEntityDetails>()}) {
         auto dataRef{ExtractDataRef(assoc->expr(), true)};
         // ASSOCIATE(a=>x) -- check x, not a, for "a=..."
         base = dataRef ? &dataRef->GetFirstSymbol() : nullptr;
       }
       if (base &&
           !CheckDefinabilityInPureScope(messages, *base, scope, *pure)) {
         return false;
       }
     }
     if (isPointerAssignment) {
       if (const Symbol * base{GetFirstSymbol(rhs)}) {
         if (const char *why{
                 WhyBaseObjectIsSuspicious(*base, scope)}) { // C1594(3)
           evaluate::SayWithDeclaration(messages, *base,
               "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
               base->name(), why);
           return false;
         }
       }
     } else if (auto type{evaluate::DynamicType::From(lhs)}) {
       // C1596 checks for polymorphic deallocation in a pure subprogram
       // due to automatic reallocation on assignment
       if (type->IsPolymorphic()) {
         context_.Say(
             "Deallocation of polymorphic object is not permitted in a pure subprogram"_err_en_US);
         return false;
       }
       if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) {
         if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent(
                 *derived)}) {
           evaluate::SayWithDeclaration(messages, *bad,
               "Deallocation of polymorphic non-coarray component '%s' is not permitted in a pure subprogram"_err_en_US,
               bad.BuildResultDesignatorName());
           return false;
         } else {
           return CheckCopyabilityInPureScope(messages, rhs, scope);
         }
       }
     }
   }
   return true;
 }
 
 // 10.2.3.1(2) The masks and LHS of assignments must all have the same shape
 void AssignmentContext::CheckShape(parser::CharBlock at, const SomeExpr *expr) {
   if (auto shape{evaluate::GetShape(foldingContext(), expr)}) {
     std::size_t size{shape->size()};
     if (whereDepth_ == 0) {
       whereExtents_.resize(size);
     } else if (whereExtents_.size() != size) {
       Say(at,
           "Must have rank %zd to match prior mask or assignment of"
           " WHERE construct"_err_en_US,
           whereExtents_.size());
       return;
     }
     for (std::size_t i{0}; i < size; ++i) {
       if (std::optional<std::int64_t> extent{evaluate::ToInt64((*shape)[i])}) {
         if (!whereExtents_[i]) {
           whereExtents_[i] = *extent;
         } else if (*whereExtents_[i] != *extent) {
           Say(at,
               "Dimension %d must have extent %jd to match prior mask or"
               " assignment of WHERE construct"_err_en_US,
               i + 1, *whereExtents_[i]);
         }
       }
     }
   }
 }
 
 template <typename A> void AssignmentContext::PushWhereContext(const A &x) {
   const auto &expr{std::get<parser::LogicalExpr>(x.t)};
   CheckShape(expr.thing.value().source, GetExpr(expr));
   ++whereDepth_;
 }
 
 void AssignmentContext::PopWhereContext() {
   --whereDepth_;
   if (whereDepth_ == 0) {
     whereExtents_.clear();
   }
 }
 
 AssignmentChecker::~AssignmentChecker() {}
 
 AssignmentChecker::AssignmentChecker(SemanticsContext &context)
     : context_{new AssignmentContext{context}} {}
 void AssignmentChecker::Enter(const parser::AssignmentStmt &x) {
   context_.value().Analyze(x);
 }
 void AssignmentChecker::Enter(const parser::PointerAssignmentStmt &x) {
   context_.value().Analyze(x);
 }
 void AssignmentChecker::Enter(const parser::WhereStmt &x) {
   context_.value().PushWhereContext(x);
 }
 void AssignmentChecker::Leave(const parser::WhereStmt &) {
   context_.value().PopWhereContext();
 }
 void AssignmentChecker::Enter(const parser::WhereConstructStmt &x) {
   context_.value().PushWhereContext(x);
 }
 void AssignmentChecker::Leave(const parser::EndWhereStmt &) {
   context_.value().PopWhereContext();
 }
 void AssignmentChecker::Enter(const parser::MaskedElsewhereStmt &x) {
   context_.value().PushWhereContext(x);
 }
 void AssignmentChecker::Leave(const parser::MaskedElsewhereStmt &) {
   context_.value().PopWhereContext();
 }
 
 } // namespace Fortran::semantics
 template class Fortran::common::Indirection<
     Fortran::semantics::AssignmentContext>;
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 26702f6c48bf..9095951389f2 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -1,952 +1,944 @@
 //===-- lib/Semantics/check-io.cpp ----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-io.h"
 #include "flang/Common/format.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/tools.h"
 #include <unordered_map>
 
 namespace Fortran::semantics {
 
 // TODO: C1234, C1235 -- defined I/O constraints
 
 class FormatErrorReporter {
 public:
   FormatErrorReporter(SemanticsContext &context,
       const parser::CharBlock &formatCharBlock, int errorAllowance = 3)
       : context_{context}, formatCharBlock_{formatCharBlock},
         errorAllowance_{errorAllowance} {}
 
   bool Say(const common::FormatMessage &);
 
 private:
   SemanticsContext &context_;
   const parser::CharBlock &formatCharBlock_;
   int errorAllowance_; // initialized to maximum number of errors to report
 };
 
 bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
   if (!msg.isError && !context_.warnOnNonstandardUsage()) {
     return false;
   }
   parser::MessageFormattedText text{
       parser::MessageFixedText(msg.text, strlen(msg.text), msg.isError),
       msg.arg};
   if (formatCharBlock_.size()) {
     // The input format is a folded expression.  Error markers span the full
     // original unfolded expression in formatCharBlock_.
     context_.Say(formatCharBlock_, text);
   } else {
     // The input format is a source expression.  Error markers have an offset
     // and length relative to the beginning of formatCharBlock_.
     parser::CharBlock messageCharBlock{
         parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)};
     context_.Say(messageCharBlock, text);
   }
   return msg.isError && --errorAllowance_ <= 0;
 }
 
 void IoChecker::Enter(
     const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) {
   if (!stmt.label) {
     context_.Say("Format statement must be labeled"_err_en_US); // C1301
   }
   const char *formatStart{static_cast<const char *>(
       std::memchr(stmt.source.begin(), '(', stmt.source.size()))};
   parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)};
   FormatErrorReporter reporter{context_, reporterCharBlock};
   auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }};
   switch (context_.GetDefaultKind(TypeCategory::Character)) {
   case 1: {
     common::FormatValidator<char> validator{formatStart,
         stmt.source.size() - (formatStart - stmt.source.begin()),
         reporterWrapper};
     validator.Check();
     break;
   }
   case 2: { // TODO: Get this to work.
     common::FormatValidator<char16_t> validator{
         /*???*/ nullptr, /*???*/ 0, reporterWrapper};
     validator.Check();
     break;
   }
   case 4: { // TODO: Get this to work.
     common::FormatValidator<char32_t> validator{
         /*???*/ nullptr, /*???*/ 0, reporterWrapper};
     validator.Check();
     break;
   }
   default:
     CRASH_NO_CASE;
   }
 }
 
 void IoChecker::Enter(const parser::ConnectSpec &spec) {
   // ConnectSpec context FileNameExpr
   if (std::get_if<parser::FileNameExpr>(&spec.u)) {
     SetSpecifier(IoSpecKind::File);
   }
 }
 
 void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::ConnectSpec::CharExpr::Kind;
   switch (std::get<ParseKind>(spec.t)) {
   case ParseKind::Access:
     specKind = IoSpecKind::Access;
     break;
   case ParseKind::Action:
     specKind = IoSpecKind::Action;
     break;
   case ParseKind::Asynchronous:
     specKind = IoSpecKind::Asynchronous;
     break;
   case ParseKind::Blank:
     specKind = IoSpecKind::Blank;
     break;
   case ParseKind::Decimal:
     specKind = IoSpecKind::Decimal;
     break;
   case ParseKind::Delim:
     specKind = IoSpecKind::Delim;
     break;
   case ParseKind::Encoding:
     specKind = IoSpecKind::Encoding;
     break;
   case ParseKind::Form:
     specKind = IoSpecKind::Form;
     break;
   case ParseKind::Pad:
     specKind = IoSpecKind::Pad;
     break;
   case ParseKind::Position:
     specKind = IoSpecKind::Position;
     break;
   case ParseKind::Round:
     specKind = IoSpecKind::Round;
     break;
   case ParseKind::Sign:
     specKind = IoSpecKind::Sign;
     break;
   case ParseKind::Carriagecontrol:
     specKind = IoSpecKind::Carriagecontrol;
     break;
   case ParseKind::Convert:
     specKind = IoSpecKind::Convert;
     break;
   case ParseKind::Dispose:
     specKind = IoSpecKind::Dispose;
     break;
   }
   SetSpecifier(specKind);
   if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
           std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
     std::string s{parser::ToUpperCaseLetters(*charConst)};
     if (specKind == IoSpecKind::Access) {
       flags_.set(Flag::KnownAccess);
       flags_.set(Flag::AccessDirect, s == "DIRECT");
       flags_.set(Flag::AccessStream, s == "STREAM");
     }
     CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
     if (specKind == IoSpecKind::Carriagecontrol &&
         (s == "FORTRAN" || s == "NONE")) {
       context_.Say(parser::FindSourceLocation(spec),
           "Unimplemented %s value '%s'"_err_en_US,
           parser::ToUpperCaseLetters(common::EnumToString(specKind)),
           *charConst);
     }
   }
 }
 
 void IoChecker::Enter(const parser::ConnectSpec::Newunit &var) {
   CheckForDefinableVariable(var, "NEWUNIT");
   SetSpecifier(IoSpecKind::Newunit);
 }
 
 void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) {
   SetSpecifier(IoSpecKind::Recl);
   if (const std::optional<std::int64_t> recl{
           GetConstExpr<std::int64_t>(spec)}) {
     if (*recl <= 0) {
       context_.Say(parser::FindSourceLocation(spec),
           "RECL value (%jd) must be positive"_err_en_US,
           *recl); // 12.5.6.15
     }
   }
 }
 
 void IoChecker::Enter(const parser::EndLabel &) {
   SetSpecifier(IoSpecKind::End);
 }
 
 void IoChecker::Enter(const parser::EorLabel &) {
   SetSpecifier(IoSpecKind::Eor);
 }
 
 void IoChecker::Enter(const parser::ErrLabel &) {
   SetSpecifier(IoSpecKind::Err);
 }
 
 void IoChecker::Enter(const parser::FileUnitNumber &) {
   SetSpecifier(IoSpecKind::Unit);
   flags_.set(Flag::NumberUnit);
 }
 
 void IoChecker::Enter(const parser::Format &spec) {
   SetSpecifier(IoSpecKind::Fmt);
   flags_.set(Flag::FmtOrNml);
   std::visit(
       common::visitors{
           [&](const parser::Label &) { flags_.set(Flag::LabelFmt); },
           [&](const parser::Star &) { flags_.set(Flag::StarFmt); },
           [&](const parser::Expr &format) {
             const SomeExpr *expr{GetExpr(format)};
             if (!expr) {
               return;
             }
             auto type{expr->GetType()};
             if (!type ||
                 (type->category() != TypeCategory::Integer &&
                     type->category() != TypeCategory::Character) ||
                 type->kind() !=
                     context_.defaultKinds().GetDefaultKind(type->category())) {
               context_.Say(format.source,
                   "Format expression must be default character or integer"_err_en_US);
               return;
             }
             if (type->category() == TypeCategory::Integer) {
               flags_.set(Flag::AssignFmt);
               if (expr->Rank() != 0 || !IsVariable(*expr)) {
                 context_.Say(format.source,
                     "Assigned format label must be a scalar variable"_err_en_US);
               }
               return;
             }
             flags_.set(Flag::CharFmt);
             const std::optional<std::string> constantFormat{
                 GetConstExpr<std::string>(format)};
             if (!constantFormat) {
               return;
             }
             // validate constant format -- 12.6.2.2
             bool isFolded{constantFormat->size() != format.source.size() - 2};
             parser::CharBlock reporterCharBlock{isFolded
                     ? parser::CharBlock{format.source}
                     : parser::CharBlock{format.source.begin() + 1,
                           static_cast<std::size_t>(0)}};
             FormatErrorReporter reporter{context_, reporterCharBlock};
             auto reporterWrapper{
                 [&](const auto &msg) { return reporter.Say(msg); }};
             switch (context_.GetDefaultKind(TypeCategory::Character)) {
             case 1: {
               common::FormatValidator<char> validator{constantFormat->c_str(),
                   constantFormat->length(), reporterWrapper, stmt_};
               validator.Check();
               break;
             }
             case 2: {
               // TODO: Get this to work.  (Maybe combine with earlier instance?)
               common::FormatValidator<char16_t> validator{
                   /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
               validator.Check();
               break;
             }
             case 4: {
               // TODO: Get this to work.  (Maybe combine with earlier instance?)
               common::FormatValidator<char32_t> validator{
                   /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
               validator.Check();
               break;
             }
             default:
               CRASH_NO_CASE;
             }
           },
       },
       spec.u);
 }
 
 void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); }
 
 void IoChecker::Enter(const parser::IdVariable &spec) {
   SetSpecifier(IoSpecKind::Id);
   const auto *expr{GetExpr(spec)};
   if (!expr || !expr->GetType()) {
     return;
   }
   CheckForDefinableVariable(spec, "ID");
   int kind{expr->GetType()->kind()};
   int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)};
   if (kind < defaultKind) {
     context_.Say(
         "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US,
         std::move(kind), std::move(defaultKind)); // C1229
   }
 }
 
 void IoChecker::Enter(const parser::InputItem &spec) {
   flags_.set(Flag::DataList);
   const parser::Variable *var{std::get_if<parser::Variable>(&spec.u)};
   if (!var) {
     return;
   }
   CheckForDefinableVariable(*var, "Input");
-  const auto &name{GetLastName(*var)};
-  const auto *expr{GetExpr(*var)};
-  if (name.symbol && IsAssumedSizeArray(*name.symbol) && expr &&
-      !evaluate::IsArrayElement(*GetExpr(*var))) {
-    context_.Say(name.source,
-        "Whole assumed size array '%s' may not be an input item"_err_en_US,
-        name.source); // C1231
-  }
 }
 
 void IoChecker::Enter(const parser::InquireSpec &spec) {
   // InquireSpec context FileNameExpr
   if (std::get_if<parser::FileNameExpr>(&spec.u)) {
     SetSpecifier(IoSpecKind::File);
   }
 }
 
 void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::InquireSpec::CharVar::Kind;
   switch (std::get<ParseKind>(spec.t)) {
   case ParseKind::Access:
     specKind = IoSpecKind::Access;
     break;
   case ParseKind::Action:
     specKind = IoSpecKind::Action;
     break;
   case ParseKind::Asynchronous:
     specKind = IoSpecKind::Asynchronous;
     break;
   case ParseKind::Blank:
     specKind = IoSpecKind::Blank;
     break;
   case ParseKind::Decimal:
     specKind = IoSpecKind::Decimal;
     break;
   case ParseKind::Delim:
     specKind = IoSpecKind::Delim;
     break;
   case ParseKind::Direct:
     specKind = IoSpecKind::Direct;
     break;
   case ParseKind::Encoding:
     specKind = IoSpecKind::Encoding;
     break;
   case ParseKind::Form:
     specKind = IoSpecKind::Form;
     break;
   case ParseKind::Formatted:
     specKind = IoSpecKind::Formatted;
     break;
   case ParseKind::Iomsg:
     specKind = IoSpecKind::Iomsg;
     break;
   case ParseKind::Name:
     specKind = IoSpecKind::Name;
     break;
   case ParseKind::Pad:
     specKind = IoSpecKind::Pad;
     break;
   case ParseKind::Position:
     specKind = IoSpecKind::Position;
     break;
   case ParseKind::Read:
     specKind = IoSpecKind::Read;
     break;
   case ParseKind::Readwrite:
     specKind = IoSpecKind::Readwrite;
     break;
   case ParseKind::Round:
     specKind = IoSpecKind::Round;
     break;
   case ParseKind::Sequential:
     specKind = IoSpecKind::Sequential;
     break;
   case ParseKind::Sign:
     specKind = IoSpecKind::Sign;
     break;
   case ParseKind::Status:
     specKind = IoSpecKind::Status;
     break;
   case ParseKind::Stream:
     specKind = IoSpecKind::Stream;
     break;
   case ParseKind::Unformatted:
     specKind = IoSpecKind::Unformatted;
     break;
   case ParseKind::Write:
     specKind = IoSpecKind::Write;
     break;
   case ParseKind::Carriagecontrol:
     specKind = IoSpecKind::Carriagecontrol;
     break;
   case ParseKind::Convert:
     specKind = IoSpecKind::Convert;
     break;
   case ParseKind::Dispose:
     specKind = IoSpecKind::Dispose;
     break;
   }
   CheckForDefinableVariable(std::get<parser::ScalarDefaultCharVariable>(spec.t),
       parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   SetSpecifier(specKind);
 }
 
 void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::InquireSpec::IntVar::Kind;
   switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) {
   case ParseKind::Iostat:
     specKind = IoSpecKind::Iostat;
     break;
   case ParseKind::Nextrec:
     specKind = IoSpecKind::Nextrec;
     break;
   case ParseKind::Number:
     specKind = IoSpecKind::Number;
     break;
   case ParseKind::Pos:
     specKind = IoSpecKind::Pos;
     break;
   case ParseKind::Recl:
     specKind = IoSpecKind::Recl;
     break;
   case ParseKind::Size:
     specKind = IoSpecKind::Size;
     break;
   }
   CheckForDefinableVariable(std::get<parser::ScalarIntVariable>(spec.t),
       parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   SetSpecifier(specKind);
 }
 
 void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::InquireSpec::LogVar::Kind;
   switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) {
   case ParseKind::Exist:
     specKind = IoSpecKind::Exist;
     break;
   case ParseKind::Named:
     specKind = IoSpecKind::Named;
     break;
   case ParseKind::Opened:
     specKind = IoSpecKind::Opened;
     break;
   case ParseKind::Pending:
     specKind = IoSpecKind::Pending;
     break;
   }
   SetSpecifier(specKind);
 }
 
 void IoChecker::Enter(const parser::IoControlSpec &spec) {
   // IoControlSpec context Name
   flags_.set(Flag::IoControlList);
   if (std::holds_alternative<parser::Name>(spec.u)) {
     SetSpecifier(IoSpecKind::Nml);
     flags_.set(Flag::FmtOrNml);
   }
 }
 
 void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) {
   SetSpecifier(IoSpecKind::Asynchronous);
   if (const std::optional<std::string> charConst{
           GetConstExpr<std::string>(spec)}) {
     flags_.set(
         Flag::AsynchronousYes, parser::ToUpperCaseLetters(*charConst) == "YES");
     CheckStringValue(IoSpecKind::Asynchronous, *charConst,
         parser::FindSourceLocation(spec)); // C1223
   }
 }
 
 void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::IoControlSpec::CharExpr::Kind;
   switch (std::get<ParseKind>(spec.t)) {
   case ParseKind::Advance:
     specKind = IoSpecKind::Advance;
     break;
   case ParseKind::Blank:
     specKind = IoSpecKind::Blank;
     break;
   case ParseKind::Decimal:
     specKind = IoSpecKind::Decimal;
     break;
   case ParseKind::Delim:
     specKind = IoSpecKind::Delim;
     break;
   case ParseKind::Pad:
     specKind = IoSpecKind::Pad;
     break;
   case ParseKind::Round:
     specKind = IoSpecKind::Round;
     break;
   case ParseKind::Sign:
     specKind = IoSpecKind::Sign;
     break;
   }
   SetSpecifier(specKind);
   if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
           std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
     if (specKind == IoSpecKind::Advance) {
       flags_.set(
           Flag::AdvanceYes, parser::ToUpperCaseLetters(*charConst) == "YES");
     }
     CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
   }
 }
 
 void IoChecker::Enter(const parser::IoControlSpec::Pos &) {
   SetSpecifier(IoSpecKind::Pos);
 }
 
 void IoChecker::Enter(const parser::IoControlSpec::Rec &) {
   SetSpecifier(IoSpecKind::Rec);
 }
 
 void IoChecker::Enter(const parser::IoControlSpec::Size &var) {
   CheckForDefinableVariable(var, "SIZE");
   SetSpecifier(IoSpecKind::Size);
 }
 
 void IoChecker::Enter(const parser::IoUnit &spec) {
   if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
     if (stmt_ == IoStmtKind::Write) {
       CheckForDefinableVariable(*var, "Internal file");
     }
     if (const auto *expr{GetExpr(*var)}) {
       if (HasVectorSubscript(*expr)) {
         context_.Say(parser::FindSourceLocation(*var), // C1201
             "Internal file must not have a vector subscript"_err_en_US);
       } else if (!ExprTypeKindIsDefault(*expr, context_)) {
         // This may be too restrictive; other kinds may be valid.
         context_.Say(parser::FindSourceLocation(*var), // C1202
             "Invalid character kind for an internal file variable"_err_en_US);
       }
     }
     SetSpecifier(IoSpecKind::Unit);
     flags_.set(Flag::InternalUnit);
   } else if (std::get_if<parser::Star>(&spec.u)) {
     SetSpecifier(IoSpecKind::Unit);
     flags_.set(Flag::StarUnit);
   }
 }
 
 void IoChecker::Enter(const parser::MsgVariable &var) {
   if (stmt_ == IoStmtKind::None) {
     // allocate, deallocate, image control
     CheckForDefinableVariable(var, "ERRMSG");
     return;
   }
   CheckForDefinableVariable(var, "IOMSG");
   SetSpecifier(IoSpecKind::Iomsg);
 }
 
 void IoChecker::Enter(const parser::OutputItem &item) {
   flags_.set(Flag::DataList);
   if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
     if (const auto *expr{GetExpr(*x)}) {
       if (IsProcedurePointer(*expr)) {
         context_.Say(parser::FindSourceLocation(*x),
             "Output item must not be a procedure pointer"_err_en_US); // C1233
       }
     }
   }
 }
 
 void IoChecker::Enter(const parser::StatusExpr &spec) {
   SetSpecifier(IoSpecKind::Status);
   if (const std::optional<std::string> charConst{
           GetConstExpr<std::string>(spec)}) {
     // Status values for Open and Close are different.
     std::string s{parser::ToUpperCaseLetters(*charConst)};
     if (stmt_ == IoStmtKind::Open) {
       flags_.set(Flag::KnownStatus);
       flags_.set(Flag::StatusNew, s == "NEW");
       flags_.set(Flag::StatusReplace, s == "REPLACE");
       flags_.set(Flag::StatusScratch, s == "SCRATCH");
       // CheckStringValue compares for OPEN Status string values.
       CheckStringValue(
           IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec));
       return;
     }
     CHECK(stmt_ == IoStmtKind::Close);
     if (s != "DELETE" && s != "KEEP") {
       context_.Say(parser::FindSourceLocation(spec),
           "Invalid STATUS value '%s'"_err_en_US, *charConst);
     }
   }
 }
 
 void IoChecker::Enter(const parser::StatVariable &var) {
   if (stmt_ == IoStmtKind::None) {
     // allocate, deallocate, image control
     CheckForDefinableVariable(var, "STAT");
     return;
   }
   CheckForDefinableVariable(var, "IOSTAT");
   SetSpecifier(IoSpecKind::Iostat);
 }
 
 void IoChecker::Leave(const parser::BackspaceStmt &) {
   CheckForPureSubprogram();
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
   Done();
 }
 
 void IoChecker::Leave(const parser::CloseStmt &) {
   CheckForPureSubprogram();
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
   Done();
 }
 
 void IoChecker::Leave(const parser::EndfileStmt &) {
   CheckForPureSubprogram();
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
   Done();
 }
 
 void IoChecker::Leave(const parser::FlushStmt &) {
   CheckForPureSubprogram();
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
   Done();
 }
 
 void IoChecker::Leave(const parser::InquireStmt &stmt) {
   if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {
     CheckForPureSubprogram();
     // Inquire by unit or by file (vs. by output list).
     CheckForRequiredSpecifier(
         flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File),
         "UNIT number or FILE"); // C1246
     CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
     CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
   }
   Done();
 }
 
 void IoChecker::Leave(const parser::OpenStmt &) {
   CheckForPureSubprogram();
   CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) ||
           specifierSet_.test(IoSpecKind::Newunit),
       "UNIT or NEWUNIT"); // C1204, C1205
   CheckForProhibitedSpecifier(
       IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205
   CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'",
       IoSpecKind::File); // 12.5.6.10
   CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace),
       "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10
   CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch),
       "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10
   if (flags_.test(Flag::KnownStatus)) {
     CheckForRequiredSpecifier(IoSpecKind::Newunit,
         specifierSet_.test(IoSpecKind::File) ||
             flags_.test(Flag::StatusScratch),
         "FILE or STATUS='SCRATCH'"); // 12.5.6.12
   } else {
     CheckForRequiredSpecifier(IoSpecKind::Newunit,
         specifierSet_.test(IoSpecKind::File) ||
             specifierSet_.test(IoSpecKind::Status),
         "FILE or STATUS"); // 12.5.6.12
   }
   if (flags_.test(Flag::KnownAccess)) {
     CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect),
         "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15
     CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),
         "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15
   }
   Done();
 }
 
 void IoChecker::Leave(const parser::PrintStmt &) {
   CheckForPureSubprogram();
   Done();
 }
 
 static void CheckForDoVariableInNamelist(const Symbol &namelist,
     SemanticsContext &context, parser::CharBlock namelistLocation) {
   const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
   for (const Symbol &object : details.objects()) {
     context.CheckIndexVarRedefine(namelistLocation, object);
   }
 }
 
 static void CheckForDoVariableInNamelistSpec(
     const parser::ReadStmt &readStmt, SemanticsContext &context) {
   const std::list<parser::IoControlSpec> &controls{readStmt.controls};
   for (const auto &control : controls) {
     if (const auto *namelist{std::get_if<parser::Name>(&control.u)}) {
       if (const Symbol * symbol{namelist->symbol}) {
         CheckForDoVariableInNamelist(*symbol, context, namelist->source);
       }
     }
   }
 }
 
 static void CheckForDoVariable(
     const parser::ReadStmt &readStmt, SemanticsContext &context) {
   CheckForDoVariableInNamelistSpec(readStmt, context);
   const std::list<parser::InputItem> &items{readStmt.items};
   for (const auto &item : items) {
     if (const parser::Variable *
         variable{std::get_if<parser::Variable>(&item.u)}) {
       context.CheckIndexVarRedefine(*variable);
     }
   }
 }
 
 void IoChecker::Leave(const parser::ReadStmt &readStmt) {
   if (!flags_.test(Flag::InternalUnit)) {
     CheckForPureSubprogram();
   }
   CheckForDoVariable(readStmt, context_);
   if (!flags_.test(Flag::IoControlList)) {
     Done();
     return;
   }
   LeaveReadWrite();
   CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
   CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
   CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
   CheckForRequiredSpecifier(IoSpecKind::Eor,
       specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes),
       "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2
   CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml),
       "FMT or NML"); // C1227
   CheckForRequiredSpecifier(
       IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
   Done();
 }
 
 void IoChecker::Leave(const parser::RewindStmt &) {
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
   CheckForPureSubprogram();
   Done();
 }
 
 void IoChecker::Leave(const parser::WaitStmt &) {
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
   CheckForPureSubprogram();
   Done();
 }
 
 void IoChecker::Leave(const parser::WriteStmt &) {
   if (!flags_.test(Flag::InternalUnit)) {
     CheckForPureSubprogram();
   }
   LeaveReadWrite();
   CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213
   CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213
   CheckForRequiredSpecifier(
       IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
   CheckForRequiredSpecifier(IoSpecKind::Delim,
       flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
       "FMT=* or NML"); // C1228
   Done();
 }
 
 void IoChecker::LeaveReadWrite() const {
   CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211
   CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216
   CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216
   CheckForProhibitedSpecifier(
       IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216
   CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
       "UNIT=internal-file", IoSpecKind::Pos); // C1219
   CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
       "UNIT=internal-file", IoSpecKind::Rec); // C1219
   CheckForProhibitedSpecifier(
       flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219
   CheckForProhibitedSpecifier(
       flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219
   CheckForProhibitedSpecifier(
       IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220
   CheckForRequiredSpecifier(IoSpecKind::Advance,
       flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt) ||
           flags_.test(Flag::AssignFmt),
       "an explicit format"); // C1221
   CheckForProhibitedSpecifier(IoSpecKind::Advance,
       flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221
   CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes),
       "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit),
       "UNIT=number"); // C1224
   CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes),
       "ASYNCHRONOUS='YES'"); // C1225
   CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226
   CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml),
       "FMT or NML"); // C1227
   CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml),
       "FMT or NML"); // C1227
 }
 
 void IoChecker::SetSpecifier(IoSpecKind specKind) {
   if (stmt_ == IoStmtKind::None) {
     // FMT may appear on PRINT statements, which don't have any checks.
     // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements.
     return;
   }
   // C1203, C1207, C1210, C1236, C1239, C1242, C1245
   if (specifierSet_.test(specKind)) {
     context_.Say("Duplicate %s specifier"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   }
   specifierSet_.set(specKind);
 }
 
 void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
     const parser::CharBlock &source) const {
   static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{
       {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}},
       {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}},
       {IoSpecKind::Advance, {"NO", "YES"}},
       {IoSpecKind::Asynchronous, {"NO", "YES"}},
       {IoSpecKind::Blank, {"NULL", "ZERO"}},
       {IoSpecKind::Decimal, {"COMMA", "POINT"}},
       {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}},
       {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}},
       {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED"}},
       {IoSpecKind::Pad, {"NO", "YES"}},
       {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}},
       {IoSpecKind::Round,
           {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},
       {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},
       {IoSpecKind::Status,
           // Open values; Close values are {"DELETE", "KEEP"}.
           {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
       {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},
       {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
       {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
   };
   if (!specValues.at(specKind).count(parser::ToUpperCaseLetters(value))) {
     context_.Say(source, "Invalid %s value '%s'"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
   }
 }
 
 // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
 // need conditions to check, and string arguments to insert into a message.
 // An IoSpecKind provides both an absence/presence condition and a string
 // argument (its name).  A (condition, string) pair provides an arbitrary
 // condition and an arbitrary string.
 
 void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {
   if (!specifierSet_.test(specKind)) {
     context_.Say("%s statement must have a %s specifier"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   }
 }
 
 void IoChecker::CheckForRequiredSpecifier(
     bool condition, const std::string &s) const {
   if (!condition) {
     context_.Say("%s statement must have a %s specifier"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);
   }
 }
 
 void IoChecker::CheckForRequiredSpecifier(
     IoSpecKind specKind1, IoSpecKind specKind2) const {
   if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {
     context_.Say("If %s appears, %s must also appear"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
   }
 }
 
 void IoChecker::CheckForRequiredSpecifier(
     IoSpecKind specKind, bool condition, const std::string &s) const {
   if (specifierSet_.test(specKind) && !condition) {
     context_.Say("If %s appears, %s must also appear"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
   }
 }
 
 void IoChecker::CheckForRequiredSpecifier(
     bool condition, const std::string &s, IoSpecKind specKind) const {
   if (condition && !specifierSet_.test(specKind)) {
     context_.Say("If %s appears, %s must also appear"_err_en_US, s,
         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   }
 }
 
 void IoChecker::CheckForRequiredSpecifier(bool condition1,
     const std::string &s1, bool condition2, const std::string &s2) const {
   if (condition1 && !condition2) {
     context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
   }
 }
 
 void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
   if (specifierSet_.test(specKind)) {
     context_.Say("%s statement must not have a %s specifier"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   }
 }
 
 void IoChecker::CheckForProhibitedSpecifier(
     IoSpecKind specKind1, IoSpecKind specKind2) const {
   if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {
     context_.Say("If %s appears, %s must not appear"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
         parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
   }
 }
 
 void IoChecker::CheckForProhibitedSpecifier(
     IoSpecKind specKind, bool condition, const std::string &s) const {
   if (specifierSet_.test(specKind) && condition) {
     context_.Say("If %s appears, %s must not appear"_err_en_US,
         parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
   }
 }
 
 void IoChecker::CheckForProhibitedSpecifier(
     bool condition, const std::string &s, IoSpecKind specKind) const {
   if (condition && specifierSet_.test(specKind)) {
     context_.Say("If %s appears, %s must not appear"_err_en_US, s,
         parser::ToUpperCaseLetters(common::EnumToString(specKind)));
   }
 }
 
 template <typename A>
 void IoChecker::CheckForDefinableVariable(
     const A &var, const std::string &s) const {
   const Symbol *sym{
       GetFirstName(*parser::Unwrap<parser::Variable>(var)).symbol};
   if (WhyNotModifiable(*sym, context_.FindScope(*context_.location()))) {
     context_.Say(parser::FindSourceLocation(var),
         "%s variable '%s' must be definable"_err_en_US, s, sym->name());
   }
 }
 
 void IoChecker::CheckForPureSubprogram() const { // C1597
   CHECK(context_.location());
   if (FindPureProcedureContaining(context_.FindScope(*context_.location()))) {
     context_.Say("External I/O is not allowed in a pure subprogram"_err_en_US);
   }
 }
 
 } // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 5a2a7df9fb98..661024f6990d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1,3193 +1,3212 @@
 //===-- lib/Semantics/expression.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Semantics/expression.h"
 #include "check-call.h"
 #include "pointer-assignment.h"
 #include "resolve-names.h"
 #include "flang/Common/idioms.h"
 #include "flang/Evaluate/common.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/dump-parse-tree.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 #include <functional>
 #include <optional>
 #include <set>
 
 // Typedef for optional generic expressions (ubiquitous in this file)
 using MaybeExpr =
     std::optional<Fortran::evaluate::Expr<Fortran::evaluate::SomeType>>;
 
 // Much of the code that implements semantic analysis of expressions is
 // tightly coupled with their typed representations in lib/Evaluate,
 // and appears here in namespace Fortran::evaluate for convenience.
 namespace Fortran::evaluate {
 
 using common::LanguageFeature;
 using common::NumericOperator;
 using common::TypeCategory;
 
 static inline std::string ToUpperCase(const std::string &str) {
   return parser::ToUpperCaseLetters(str);
 }
 
 struct DynamicTypeWithLength : public DynamicType {
   explicit DynamicTypeWithLength(const DynamicType &t) : DynamicType{t} {}
   std::optional<Expr<SubscriptInteger>> LEN() const;
   std::optional<Expr<SubscriptInteger>> length;
 };
 
 std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
   if (length) {
     return length;
   }
   if (auto *lengthParam{charLength()}) {
     if (const auto &len{lengthParam->GetExplicit()}) {
       return ConvertToType<SubscriptInteger>(common::Clone(*len));
     }
   }
   return std::nullopt; // assumed or deferred length
 }
 
 static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
     const std::optional<parser::TypeSpec> &spec) {
   if (spec) {
     if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
       // Name resolution sets TypeSpec::declTypeSpec only when it's valid
       // (viz., an intrinsic type with valid known kind or a non-polymorphic
       // & non-ABSTRACT derived type).
       if (const semantics::IntrinsicTypeSpec *
           intrinsic{typeSpec->AsIntrinsic()}) {
         TypeCategory category{intrinsic->category()};
         if (auto optKind{ToInt64(intrinsic->kind())}) {
           int kind{static_cast<int>(*optKind)};
           if (category == TypeCategory::Character) {
             const semantics::CharacterTypeSpec &cts{
                 typeSpec->characterTypeSpec()};
             const semantics::ParamValue &len{cts.length()};
             // N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
             // type guards, but not in array constructors.
             return DynamicTypeWithLength{DynamicType{kind, len}};
           } else {
             return DynamicTypeWithLength{DynamicType{category, kind}};
           }
         }
       } else if (const semantics::DerivedTypeSpec *
           derived{typeSpec->AsDerived()}) {
         return DynamicTypeWithLength{DynamicType{*derived}};
       }
     }
   }
   return std::nullopt;
 }
 
 class ArgumentAnalyzer {
 public:
   explicit ArgumentAnalyzer(ExpressionAnalyzer &context)
       : context_{context}, isProcedureCall_{false} {}
   ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source,
       bool isProcedureCall = false)
       : context_{context}, source_{source}, isProcedureCall_{isProcedureCall} {}
   bool fatalErrors() const { return fatalErrors_; }
   ActualArguments &&GetActuals() {
     CHECK(!fatalErrors_);
     return std::move(actuals_);
   }
   const Expr<SomeType> &GetExpr(std::size_t i) const {
     return DEREF(actuals_.at(i).value().UnwrapExpr());
   }
   Expr<SomeType> &&MoveExpr(std::size_t i) {
     return std::move(DEREF(actuals_.at(i).value().UnwrapExpr()));
   }
   void Analyze(const common::Indirection<parser::Expr> &x) {
     Analyze(x.value());
   }
   void Analyze(const parser::Expr &x) {
     actuals_.emplace_back(AnalyzeExpr(x));
     fatalErrors_ |= !actuals_.back();
   }
   void Analyze(const parser::Variable &);
   void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
   void ConvertBOZ(std::size_t i, std::optional<DynamicType> otherType);
 
   bool IsIntrinsicRelational(RelationalOperator) const;
   bool IsIntrinsicLogical() const;
   bool IsIntrinsicNumeric(NumericOperator) const;
   bool IsIntrinsicConcat() const;
 
   bool CheckConformance() const;
 
   // Find and return a user-defined operator or report an error.
   // The provided message is used if there is no such operator.
   MaybeExpr TryDefinedOp(
       const char *, parser::MessageFixedText &&, bool isUserOp = false);
   template <typename E>
   MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText &&msg) {
     return TryDefinedOp(
         context_.context().languageFeatures().GetNames(opr), std::move(msg));
   }
   // Find and return a user-defined assignment
   std::optional<ProcedureRef> TryDefinedAssignment();
   std::optional<ProcedureRef> GetDefinedAssignmentProc();
   std::optional<DynamicType> GetType(std::size_t) const;
   void Dump(llvm::raw_ostream &);
 
 private:
   MaybeExpr TryDefinedOp(
       std::vector<const char *>, parser::MessageFixedText &&);
   MaybeExpr TryBoundOp(const Symbol &, int passIndex);
   std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
+  MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
   bool AreConformable() const;
   const Symbol *FindBoundOp(parser::CharBlock, int passIndex);
   void AddAssignmentConversion(
       const DynamicType &lhsType, const DynamicType &rhsType);
   bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
   int GetRank(std::size_t) const;
   bool IsBOZLiteral(std::size_t i) const {
     return std::holds_alternative<BOZLiteralConstant>(GetExpr(i).u);
   }
   void SayNoMatch(const std::string &, bool isAssignment = false);
   std::string TypeAsFortran(std::size_t);
   bool AnyUntypedOperand();
 
   ExpressionAnalyzer &context_;
   ActualArguments actuals_;
   parser::CharBlock source_;
   bool fatalErrors_{false};
   const bool isProcedureCall_; // false for user-defined op or assignment
   const Symbol *sawDefinedOp_{nullptr};
 };
 
 // Wraps a data reference in a typed Designator<>, and a procedure
 // or procedure pointer reference in a ProcedureDesignator.
 MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
   const Symbol &symbol{ref.GetLastSymbol().GetUltimate()};
   if (semantics::IsProcedure(symbol)) {
     if (auto *component{std::get_if<Component>(&ref.u)}) {
       return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
     } else if (!std::holds_alternative<SymbolRef>(ref.u)) {
       DIE("unexpected alternative in DataRef");
     } else if (!symbol.attrs().test(semantics::Attr::INTRINSIC)) {
       return Expr<SomeType>{ProcedureDesignator{symbol}};
     } else if (auto interface{context_.intrinsics().IsSpecificIntrinsicFunction(
                    symbol.name().ToString())}) {
       SpecificIntrinsic intrinsic{
           symbol.name().ToString(), std::move(*interface)};
       intrinsic.isRestrictedSpecific = interface->isRestrictedSpecific;
       return Expr<SomeType>{ProcedureDesignator{std::move(intrinsic)}};
     } else {
       Say("'%s' is not a specific intrinsic procedure"_err_en_US,
           symbol.name());
       return std::nullopt;
     }
   } else if (auto dyType{DynamicType::From(symbol)}) {
     return TypedWrapper<Designator, DataRef>(*dyType, std::move(ref));
   }
   return std::nullopt;
 }
 
 // Some subscript semantic checks must be deferred until all of the
 // subscripts are in hand.
 MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
   const Symbol &symbol{ref.GetLastSymbol().GetUltimate()};
   const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
   int symbolRank{symbol.Rank()};
   int subscripts{static_cast<int>(ref.size())};
   if (subscripts == 0) {
     // nothing to check
   } else if (subscripts != symbolRank) {
     if (symbolRank != 0) {
       Say("Reference to rank-%d object '%s' has %d subscripts"_err_en_US,
           symbolRank, symbol.name(), subscripts);
     }
     return std::nullopt;
   } else if (Component * component{ref.base().UnwrapComponent()}) {
     int baseRank{component->base().Rank()};
     if (baseRank > 0) {
       int subscriptRank{0};
       for (const auto &expr : ref.subscript()) {
         subscriptRank += expr.Rank();
       }
       if (subscriptRank > 0) {
         Say("Subscripts of component '%s' of rank-%d derived type "
             "array have rank %d but must all be scalar"_err_en_US,
             symbol.name(), baseRank, subscriptRank);
         return std::nullopt;
       }
     }
   } else if (object) {
     // C928 & C1002
     if (Triplet * last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
       if (!last->upper() && object->IsAssumedSize()) {
         Say("Assumed-size array '%s' must have explicit final "
             "subscript upper bound value"_err_en_US,
             symbol.name());
         return std::nullopt;
       }
     }
   }
   return Designate(DataRef{std::move(ref)});
 }
 
 // Applies subscripts to a data reference.
 MaybeExpr ExpressionAnalyzer::ApplySubscripts(
     DataRef &&dataRef, std::vector<Subscript> &&subscripts) {
   return std::visit(
       common::visitors{
           [&](SymbolRef &&symbol) {
             return CompleteSubscripts(ArrayRef{symbol, std::move(subscripts)});
           },
           [&](Component &&c) {
             return CompleteSubscripts(
                 ArrayRef{std::move(c), std::move(subscripts)});
           },
           [&](auto &&) -> MaybeExpr {
             DIE("bad base for ArrayRef");
             return std::nullopt;
           },
       },
       std::move(dataRef.u));
 }
 
 // Top-level checks for data references.
 MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
   if (Component * component{std::get_if<Component>(&dataRef.u)}) {
     const Symbol &symbol{component->GetLastSymbol()};
     int componentRank{symbol.Rank()};
     if (componentRank > 0) {
       int baseRank{component->base().Rank()};
       if (baseRank > 0) {
         Say("Reference to whole rank-%d component '%%%s' of "
             "rank-%d array of derived type is not allowed"_err_en_US,
             componentRank, symbol.name(), baseRank);
       }
     }
   }
   return Designate(std::move(dataRef));
 }
 
 // Parse tree correction after a substring S(j:k) was misparsed as an
 // array section.  N.B. Fortran substrings have to have a range, not a
 // single index.
 static void FixMisparsedSubstring(const parser::Designator &d) {
   auto &mutate{const_cast<parser::Designator &>(d)};
   if (auto *dataRef{std::get_if<parser::DataRef>(&mutate.u)}) {
     if (auto *ae{std::get_if<common::Indirection<parser::ArrayElement>>(
             &dataRef->u)}) {
       parser::ArrayElement &arrElement{ae->value()};
       if (!arrElement.subscripts.empty()) {
         auto iter{arrElement.subscripts.begin()};
         if (auto *triplet{std::get_if<parser::SubscriptTriplet>(&iter->u)}) {
           if (!std::get<2>(triplet->t) /* no stride */ &&
               ++iter == arrElement.subscripts.end() /* one subscript */) {
             if (Symbol *
                 symbol{std::visit(
                     common::visitors{
                         [](parser::Name &n) { return n.symbol; },
                         [](common::Indirection<parser::StructureComponent>
                                 &sc) { return sc.value().component.symbol; },
                         [](auto &) -> Symbol * { return nullptr; },
                     },
                     arrElement.base.u)}) {
               const Symbol &ultimate{symbol->GetUltimate()};
               if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
                 if (!ultimate.IsObjectArray() &&
                     type->category() == semantics::DeclTypeSpec::Character) {
                   // The ambiguous S(j:k) was parsed as an array section
                   // reference, but it's now clear that it's a substring.
                   // Fix the parse tree in situ.
                   mutate.u = arrElement.ConvertToSubstring();
                 }
               }
             }
           }
         }
       }
     }
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
   auto restorer{GetContextualMessages().SetLocation(d.source)};
   FixMisparsedSubstring(d);
   // These checks have to be deferred to these "top level" data-refs where
   // we can be sure that there are no following subscripts (yet).
   // Substrings have already been run through TopLevelChecks() and
   // won't be returned by ExtractDataRef().
   if (MaybeExpr result{Analyze(d.u)}) {
     if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
       return TopLevelChecks(std::move(*dataRef));
     }
     return result;
   }
   return std::nullopt;
 }
 
 // A utility subroutine to repackage optional expressions of various levels
 // of type specificity as fully general MaybeExpr values.
 template <typename A> common::IfNoLvalue<MaybeExpr, A> AsMaybeExpr(A &&x) {
   return AsGenericExpr(std::move(x));
 }
 template <typename A> MaybeExpr AsMaybeExpr(std::optional<A> &&x) {
   if (x) {
     return AsMaybeExpr(std::move(*x));
   }
   return std::nullopt;
 }
 
 // Type kind parameter values for literal constants.
 int ExpressionAnalyzer::AnalyzeKindParam(
     const std::optional<parser::KindParam> &kindParam, int defaultKind) {
   if (!kindParam) {
     return defaultKind;
   }
   return std::visit(
       common::visitors{
           [](std::uint64_t k) { return static_cast<int>(k); },
           [&](const parser::Scalar<
               parser::Integer<parser::Constant<parser::Name>>> &n) {
             if (MaybeExpr ie{Analyze(n)}) {
               if (std::optional<std::int64_t> i64{ToInt64(*ie)}) {
                 int iv = *i64;
                 if (iv == *i64) {
                   return iv;
                 }
               }
             }
             return defaultKind;
           },
       },
       kindParam->u);
 }
 
 // Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
 struct IntTypeVisitor {
   using Result = MaybeExpr;
   using Types = IntegerTypes;
   template <typename T> Result Test() {
     if (T::kind >= kind) {
       const char *p{digits.begin()};
       auto value{T::Scalar::Read(p, 10, true /*signed*/)};
       if (!value.overflow) {
         if (T::kind > kind) {
           if (!isDefaultKind ||
               !analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
             return std::nullopt;
           } else if (analyzer.context().ShouldWarn(
                          LanguageFeature::BigIntLiterals)) {
             analyzer.Say(digits,
                 "Integer literal is too large for default INTEGER(KIND=%d); "
                 "assuming INTEGER(KIND=%d)"_en_US,
                 kind, T::kind);
           }
         }
         return Expr<SomeType>{
             Expr<SomeInteger>{Expr<T>{Constant<T>{std::move(value.value)}}}};
       }
     }
     return std::nullopt;
   }
   ExpressionAnalyzer &analyzer;
   parser::CharBlock digits;
   int kind;
   bool isDefaultKind;
 };
 
 template <typename PARSED>
 MaybeExpr ExpressionAnalyzer::IntLiteralConstant(const PARSED &x) {
   const auto &kindParam{std::get<std::optional<parser::KindParam>>(x.t)};
   bool isDefaultKind{!kindParam};
   int kind{AnalyzeKindParam(kindParam, GetDefaultKind(TypeCategory::Integer))};
   if (CheckIntrinsicKind(TypeCategory::Integer, kind)) {
     auto digits{std::get<parser::CharBlock>(x.t)};
     if (MaybeExpr result{common::SearchTypes(
             IntTypeVisitor{*this, digits, kind, isDefaultKind})}) {
       return result;
     } else if (isDefaultKind) {
       Say(digits,
           "Integer literal is too large for any allowable "
           "kind of INTEGER"_err_en_US);
     } else {
       Say(digits, "Integer literal is too large for INTEGER(KIND=%d)"_err_en_US,
           kind);
     }
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::IntLiteralConstant &x) {
   auto restorer{
       GetContextualMessages().SetLocation(std::get<parser::CharBlock>(x.t))};
   return IntLiteralConstant(x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::SignedIntLiteralConstant &x) {
   auto restorer{GetContextualMessages().SetLocation(x.source)};
   return IntLiteralConstant(x);
 }
 
 template <typename TYPE>
 Constant<TYPE> ReadRealLiteral(
     parser::CharBlock source, FoldingContext &context) {
   const char *p{source.begin()};
   auto valWithFlags{Scalar<TYPE>::Read(p, context.rounding())};
   CHECK(p == source.end());
   RealFlagWarnings(context, valWithFlags.flags, "conversion of REAL literal");
   auto value{valWithFlags.value};
   if (context.flushSubnormalsToZero()) {
     value = value.FlushSubnormalToZero();
   }
   return {value};
 }
 
 struct RealTypeVisitor {
   using Result = std::optional<Expr<SomeReal>>;
   using Types = RealTypes;
 
   RealTypeVisitor(int k, parser::CharBlock lit, FoldingContext &ctx)
       : kind{k}, literal{lit}, context{ctx} {}
 
   template <typename T> Result Test() {
     if (kind == T::kind) {
       return {AsCategoryExpr(ReadRealLiteral<T>(literal, context))};
     }
     return std::nullopt;
   }
 
   int kind;
   parser::CharBlock literal;
   FoldingContext &context;
 };
 
 // Reads a real literal constant and encodes it with the right kind.
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
   // Use a local message context around the real literal for better
   // provenance on any messages.
   auto restorer{GetContextualMessages().SetLocation(x.real.source)};
   // If a kind parameter appears, it defines the kind of the literal and the
   // letter used in an exponent part must be 'E' (e.g., the 'E' in
   // "6.02214E+23").  In the absence of an explicit kind parameter, any
   // exponent letter determines the kind.  Otherwise, defaults apply.
   auto &defaults{context_.defaultKinds()};
   int defaultKind{defaults.GetDefaultKind(TypeCategory::Real)};
   const char *end{x.real.source.end()};
   char expoLetter{' '};
   std::optional<int> letterKind;
   for (const char *p{x.real.source.begin()}; p < end; ++p) {
     if (parser::IsLetter(*p)) {
       expoLetter = *p;
       switch (expoLetter) {
       case 'e':
         letterKind = defaults.GetDefaultKind(TypeCategory::Real);
         break;
       case 'd':
         letterKind = defaults.doublePrecisionKind();
         break;
       case 'q':
         letterKind = defaults.quadPrecisionKind();
         break;
       default:
         Say("Unknown exponent letter '%c'"_err_en_US, expoLetter);
       }
       break;
     }
   }
   if (letterKind) {
     defaultKind = *letterKind;
   }
   // C716 requires 'E' as an exponent, but this is more useful
   auto kind{AnalyzeKindParam(x.kind, defaultKind)};
   if (letterKind && kind != *letterKind && expoLetter != 'e') {
     Say("Explicit kind parameter on real constant disagrees with "
         "exponent letter '%c'"_en_US,
         expoLetter);
   }
   auto result{common::SearchTypes(
       RealTypeVisitor{kind, x.real.source, GetFoldingContext()})};
   if (!result) { // C717
     Say("Unsupported REAL(KIND=%d)"_err_en_US, kind);
   }
   return AsMaybeExpr(std::move(result));
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::SignedRealLiteralConstant &x) {
   if (auto result{Analyze(std::get<parser::RealLiteralConstant>(x.t))}) {
     auto &realExpr{std::get<Expr<SomeReal>>(result->u)};
     if (auto sign{std::get<std::optional<parser::Sign>>(x.t)}) {
       if (sign == parser::Sign::Negative) {
         return AsGenericExpr(-std::move(realExpr));
       }
     }
     return result;
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::SignedComplexLiteralConstant &x) {
   auto result{Analyze(std::get<parser::ComplexLiteralConstant>(x.t))};
   if (!result) {
     return std::nullopt;
   } else if (std::get<parser::Sign>(x.t) == parser::Sign::Negative) {
     return AsGenericExpr(-std::move(std::get<Expr<SomeComplex>>(result->u)));
   } else {
     return result;
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ComplexPart &x) {
   return Analyze(x.u);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ComplexLiteralConstant &z) {
   return AsMaybeExpr(
       ConstructComplex(GetContextualMessages(), Analyze(std::get<0>(z.t)),
           Analyze(std::get<1>(z.t)), GetDefaultKind(TypeCategory::Real)));
 }
 
 // CHARACTER literal processing.
 MaybeExpr ExpressionAnalyzer::AnalyzeString(std::string &&string, int kind) {
   if (!CheckIntrinsicKind(TypeCategory::Character, kind)) {
     return std::nullopt;
   }
   switch (kind) {
   case 1:
     return AsGenericExpr(Constant<Type<TypeCategory::Character, 1>>{
         parser::DecodeString<std::string, parser::Encoding::LATIN_1>(
             string, true)});
   case 2:
     return AsGenericExpr(Constant<Type<TypeCategory::Character, 2>>{
         parser::DecodeString<std::u16string, parser::Encoding::UTF_8>(
             string, true)});
   case 4:
     return AsGenericExpr(Constant<Type<TypeCategory::Character, 4>>{
         parser::DecodeString<std::u32string, parser::Encoding::UTF_8>(
             string, true)});
   default:
     CRASH_NO_CASE;
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::CharLiteralConstant &x) {
   int kind{
       AnalyzeKindParam(std::get<std::optional<parser::KindParam>>(x.t), 1)};
   auto value{std::get<std::string>(x.t)};
   return AnalyzeString(std::move(value), kind);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::HollerithLiteralConstant &x) {
   int kind{GetDefaultKind(TypeCategory::Character)};
   auto value{x.v};
   return AnalyzeString(std::move(value), kind);
 }
 
 // .TRUE. and .FALSE. of various kinds
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::LogicalLiteralConstant &x) {
   auto kind{AnalyzeKindParam(std::get<std::optional<parser::KindParam>>(x.t),
       GetDefaultKind(TypeCategory::Logical))};
   bool value{std::get<bool>(x.t)};
   auto result{common::SearchTypes(
       TypeKindVisitor<TypeCategory::Logical, Constant, bool>{
           kind, std::move(value)})};
   if (!result) {
     Say("unsupported LOGICAL(KIND=%d)"_err_en_US, kind); // C728
   }
   return result;
 }
 
 // BOZ typeless literals
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
   const char *p{x.v.c_str()};
   std::uint64_t base{16};
   switch (*p++) {
   case 'b':
     base = 2;
     break;
   case 'o':
     base = 8;
     break;
   case 'z':
     break;
   case 'x':
     break;
   default:
     CRASH_NO_CASE;
   }
   CHECK(*p == '"');
   ++p;
   auto value{BOZLiteralConstant::Read(p, base, false /*unsigned*/)};
   if (*p != '"') {
     Say("Invalid digit ('%c') in BOZ literal '%s'"_err_en_US, *p,
         x.v); // C7107, C7108
     return std::nullopt;
   }
   if (value.overflow) {
     Say("BOZ literal '%s' too large"_err_en_US, x.v);
     return std::nullopt;
   }
   return AsGenericExpr(std::move(value.value));
 }
 
 // Names and named constants
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
   if (std::optional<int> kind{IsImpliedDo(n.source)}) {
     return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
         *kind, AsExpr(ImpliedDoIndex{n.source})));
   } else if (context_.HasError(n)) {
     return std::nullopt;
   } else if (!n.symbol) {
     SayAt(n, "Internal error: unresolved name '%s'"_err_en_US, n.source);
     return std::nullopt;
   } else {
     const Symbol &ultimate{n.symbol->GetUltimate()};
     if (ultimate.has<semantics::TypeParamDetails>()) {
       // A bare reference to a derived type parameter (within a parameterized
       // derived type definition)
       return Fold(ConvertToType(
           ultimate, AsGenericExpr(TypeParamInquiry{std::nullopt, ultimate})));
     } else {
       if (n.symbol->attrs().test(semantics::Attr::VOLATILE)) {
         if (const semantics::Scope *
             pure{semantics::FindPureProcedureContaining(
                 context_.FindScope(n.source))}) {
           SayAt(n,
               "VOLATILE variable '%s' may not be referenced in pure subprogram '%s'"_err_en_US,
               n.source, DEREF(pure->symbol()).name());
           n.symbol->attrs().reset(semantics::Attr::VOLATILE);
         }
       }
+      if (!isWholeAssumedSizeArrayOk_ &&
+          semantics::IsAssumedSizeArray(*n.symbol)) { // C1002, C1014, C1231
+        AttachDeclaration(
+            SayAt(n,
+                "Whole assumed-size array '%s' may not appear here without subscripts"_err_en_US,
+                n.source),
+            *n.symbol);
+      }
       return Designate(DataRef{*n.symbol});
     }
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
   if (MaybeExpr value{Analyze(n.v)}) {
     Expr<SomeType> folded{Fold(std::move(*value))};
     if (IsConstantExpr(folded)) {
       return folded;
     }
     Say(n.v.source, "must be a constant"_err_en_US); // C718
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::NullInit &x) {
   return Expr<SomeType>{NullPointer{}};
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::InitialDataTarget &x) {
   return Analyze(x.value());
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtValue &x) {
   if (const auto &repeat{
           std::get<std::optional<parser::DataStmtRepeat>>(x.t)}) {
     x.repetitions = -1;
     if (MaybeExpr expr{Analyze(repeat->u)}) {
       Expr<SomeType> folded{Fold(std::move(*expr))};
       if (auto value{ToInt64(folded)}) {
         if (*value >= 0) { // C882
           x.repetitions = *value;
         } else {
           Say(FindSourceLocation(repeat),
               "Repeat count (%jd) for data value must not be negative"_err_en_US,
               *value);
         }
       }
     }
   }
   return Analyze(std::get<parser::DataStmtConstant>(x.t));
 }
 
 // Substring references
 std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::GetSubstringBound(
     const std::optional<parser::ScalarIntExpr> &bound) {
   if (bound) {
     if (MaybeExpr expr{Analyze(*bound)}) {
       if (expr->Rank() > 1) {
         Say("substring bound expression has rank %d"_err_en_US, expr->Rank());
       }
       if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
         if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
           return {std::move(*ssIntExpr)};
         }
         return {Expr<SubscriptInteger>{
             Convert<SubscriptInteger, TypeCategory::Integer>{
                 std::move(*intExpr)}}};
       } else {
         Say("substring bound expression is not INTEGER"_err_en_US);
       }
     }
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Substring &ss) {
   if (MaybeExpr baseExpr{Analyze(std::get<parser::DataRef>(ss.t))}) {
     if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
       if (MaybeExpr newBaseExpr{TopLevelChecks(std::move(*dataRef))}) {
         if (std::optional<DataRef> checked{
                 ExtractDataRef(std::move(*newBaseExpr))}) {
           const parser::SubstringRange &range{
               std::get<parser::SubstringRange>(ss.t)};
           std::optional<Expr<SubscriptInteger>> first{
               GetSubstringBound(std::get<0>(range.t))};
           std::optional<Expr<SubscriptInteger>> last{
               GetSubstringBound(std::get<1>(range.t))};
           const Symbol &symbol{checked->GetLastSymbol()};
           if (std::optional<DynamicType> dynamicType{
                   DynamicType::From(symbol)}) {
             if (dynamicType->category() == TypeCategory::Character) {
               return WrapperHelper<TypeCategory::Character, Designator,
                   Substring>(dynamicType->kind(),
                   Substring{std::move(checked.value()), std::move(first),
                       std::move(last)});
             }
           }
           Say("substring may apply only to CHARACTER"_err_en_US);
         }
       }
     }
   }
   return std::nullopt;
 }
 
 // CHARACTER literal substrings
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::CharLiteralConstantSubstring &x) {
   const parser::SubstringRange &range{std::get<parser::SubstringRange>(x.t)};
   std::optional<Expr<SubscriptInteger>> lower{
       GetSubstringBound(std::get<0>(range.t))};
   std::optional<Expr<SubscriptInteger>> upper{
       GetSubstringBound(std::get<1>(range.t))};
   if (MaybeExpr string{Analyze(std::get<parser::CharLiteralConstant>(x.t))}) {
     if (auto *charExpr{std::get_if<Expr<SomeCharacter>>(&string->u)}) {
       Expr<SubscriptInteger> length{
           std::visit([](const auto &ckExpr) { return ckExpr.LEN().value(); },
               charExpr->u)};
       if (!lower) {
         lower = Expr<SubscriptInteger>{1};
       }
       if (!upper) {
         upper = Expr<SubscriptInteger>{
             static_cast<std::int64_t>(ToInt64(length).value())};
       }
       return std::visit(
           [&](auto &&ckExpr) -> MaybeExpr {
             using Result = ResultType<decltype(ckExpr)>;
             auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
             CHECK(DEREF(cp).size() == 1);
             StaticDataObject::Pointer staticData{StaticDataObject::Create()};
             staticData->set_alignment(Result::kind)
                 .set_itemBytes(Result::kind)
                 .Push(cp->GetScalarValue().value());
             Substring substring{std::move(staticData), std::move(lower.value()),
                 std::move(upper.value())};
             return AsGenericExpr(
                 Expr<Result>{Designator<Result>{std::move(substring)}});
           },
           std::move(charExpr->u));
     }
   }
   return std::nullopt;
 }
 
 // Subscripted array references
 std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::AsSubscript(
     MaybeExpr &&expr) {
   if (expr) {
     if (expr->Rank() > 1) {
       Say("Subscript expression has rank %d greater than 1"_err_en_US,
           expr->Rank());
     }
     if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
       if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
         return std::move(*ssIntExpr);
       } else {
         return Expr<SubscriptInteger>{
             Convert<SubscriptInteger, TypeCategory::Integer>{
                 std::move(*intExpr)}};
       }
     } else {
       Say("Subscript expression is not INTEGER"_err_en_US);
     }
   }
   return std::nullopt;
 }
 
 std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::TripletPart(
     const std::optional<parser::Subscript> &s) {
   if (s) {
     return AsSubscript(Analyze(*s));
   } else {
     return std::nullopt;
   }
 }
 
 std::optional<Subscript> ExpressionAnalyzer::AnalyzeSectionSubscript(
     const parser::SectionSubscript &ss) {
   return std::visit(
       common::visitors{
           [&](const parser::SubscriptTriplet &t) -> std::optional<Subscript> {
             const auto &lower{std::get<0>(t.t)};
             const auto &upper{std::get<1>(t.t)};
             const auto &stride{std::get<2>(t.t)};
             auto result{Triplet{
                 TripletPart(lower), TripletPart(upper), TripletPart(stride)}};
             if ((lower && !result.lower()) || (upper && !result.upper())) {
               return std::nullopt;
             } else {
               return std::make_optional<Subscript>(result);
             }
           },
           [&](const auto &s) -> std::optional<Subscript> {
             if (auto subscriptExpr{AsSubscript(Analyze(s))}) {
               return Subscript{std::move(*subscriptExpr)};
             } else {
               return std::nullopt;
             }
           },
       },
       ss.u);
 }
 
 // Empty result means an error occurred
 std::vector<Subscript> ExpressionAnalyzer::AnalyzeSectionSubscripts(
     const std::list<parser::SectionSubscript> &sss) {
   bool error{false};
   std::vector<Subscript> subscripts;
   for (const auto &s : sss) {
     if (auto subscript{AnalyzeSectionSubscript(s)}) {
       subscripts.emplace_back(std::move(*subscript));
     } else {
       error = true;
     }
   }
   return !error ? subscripts : std::vector<Subscript>{};
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayElement &ae) {
-  if (MaybeExpr baseExpr{Analyze(ae.base)}) {
+  MaybeExpr baseExpr;
+  {
+    auto restorer{AllowWholeAssumedSizeArray()};
+    baseExpr = Analyze(ae.base);
+  }
+  if (baseExpr) {
     if (ae.subscripts.empty()) {
       // will be converted to function call later or error reported
       return std::nullopt;
     } else if (baseExpr->Rank() == 0) {
       if (const Symbol * symbol{GetLastSymbol(*baseExpr)}) {
         if (!context_.HasError(symbol)) {
           Say("'%s' is not an array"_err_en_US, symbol->name());
           context_.SetError(*symbol);
         }
       }
     } else if (std::optional<DataRef> dataRef{
                    ExtractDataRef(std::move(*baseExpr))}) {
       return ApplySubscripts(
           std::move(*dataRef), AnalyzeSectionSubscripts(ae.subscripts));
     } else {
       Say("Subscripts may be applied only to an object, component, or array constant"_err_en_US);
     }
   }
   // error was reported: analyze subscripts without reporting more errors
   auto restorer{GetContextualMessages().DiscardMessages()};
   AnalyzeSectionSubscripts(ae.subscripts);
   return std::nullopt;
 }
 
 // Type parameter inquiries apply to data references, but don't depend
 // on any trailing (co)subscripts.
 static NamedEntity IgnoreAnySubscripts(Designator<SomeDerived> &&designator) {
   return std::visit(
       common::visitors{
           [](SymbolRef &&symbol) { return NamedEntity{symbol}; },
           [](Component &&component) {
             return NamedEntity{std::move(component)};
           },
           [](ArrayRef &&arrayRef) { return std::move(arrayRef.base()); },
           [](CoarrayRef &&coarrayRef) {
             return NamedEntity{coarrayRef.GetLastSymbol()};
           },
       },
       std::move(designator.u));
 }
 
 // Components of parent derived types are explicitly represented as such.
 static std::optional<Component> CreateComponent(
     DataRef &&base, const Symbol &component, const semantics::Scope &scope) {
   if (&component.owner() == &scope) {
     return Component{std::move(base), component};
   }
   if (const semantics::Scope * parentScope{scope.GetDerivedTypeParent()}) {
     if (const Symbol * parentComponent{parentScope->GetSymbol()}) {
       return CreateComponent(
           DataRef{Component{std::move(base), *parentComponent}}, component,
           *parentScope);
     }
   }
   return std::nullopt;
 }
 
 // Derived type component references and type parameter inquiries
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::StructureComponent &sc) {
   MaybeExpr base{Analyze(sc.base)};
   if (!base) {
     return std::nullopt;
   }
   Symbol *sym{sc.component.symbol};
   if (context_.HasError(sym)) {
     return std::nullopt;
   }
   const auto &name{sc.component.source};
   if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
     const auto *dtSpec{GetDerivedTypeSpec(dtExpr->GetType())};
     if (sym->detailsIf<semantics::TypeParamDetails>()) {
       if (auto *designator{UnwrapExpr<Designator<SomeDerived>>(*dtExpr)}) {
         if (std::optional<DynamicType> dyType{DynamicType::From(*sym)}) {
           if (dyType->category() == TypeCategory::Integer) {
             return Fold(ConvertToType(*dyType,
                 AsGenericExpr(TypeParamInquiry{
                     IgnoreAnySubscripts(std::move(*designator)), *sym})));
           }
         }
         Say(name, "Type parameter is not INTEGER"_err_en_US);
       } else {
         Say(name,
             "A type parameter inquiry must be applied to "
             "a designator"_err_en_US);
       }
     } else if (!dtSpec || !dtSpec->scope()) {
       CHECK(context_.AnyFatalError() || !foldingContext_.messages().empty());
       return std::nullopt;
     } else if (std::optional<DataRef> dataRef{
                    ExtractDataRef(std::move(*dtExpr))}) {
       if (auto component{
               CreateComponent(std::move(*dataRef), *sym, *dtSpec->scope())}) {
         return Designate(DataRef{std::move(*component)});
       } else {
         Say(name, "Component is not in scope of derived TYPE(%s)"_err_en_US,
             dtSpec->typeSymbol().name());
       }
     } else {
       Say(name,
           "Base of component reference must be a data reference"_err_en_US);
     }
   } else if (auto *details{sym->detailsIf<semantics::MiscDetails>()}) {
     // special part-ref: %re, %im, %kind, %len
     // Type errors are detected and reported in semantics.
     using MiscKind = semantics::MiscDetails::Kind;
     MiscKind kind{details->kind()};
     if (kind == MiscKind::ComplexPartRe || kind == MiscKind::ComplexPartIm) {
       if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&base->u)}) {
         if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*zExpr))}) {
           Expr<SomeReal> realExpr{std::visit(
               [&](const auto &z) {
                 using PartType = typename ResultType<decltype(z)>::Part;
                 auto part{kind == MiscKind::ComplexPartRe
                         ? ComplexPart::Part::RE
                         : ComplexPart::Part::IM};
                 return AsCategoryExpr(Designator<PartType>{
                     ComplexPart{std::move(*dataRef), part}});
               },
               zExpr->u)};
           return AsGenericExpr(std::move(realExpr));
         }
       }
     } else if (kind == MiscKind::KindParamInquiry ||
         kind == MiscKind::LenParamInquiry) {
       // Convert x%KIND -> intrinsic KIND(x), x%LEN -> intrinsic LEN(x)
       return MakeFunctionRef(
           name, ActualArguments{ActualArgument{std::move(*base)}});
     } else {
       DIE("unexpected MiscDetails::Kind");
     }
   } else {
     Say(name, "derived type required before component reference"_err_en_US);
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
   if (auto maybeDataRef{ExtractDataRef(Analyze(x.base))}) {
     DataRef *dataRef{&*maybeDataRef};
     std::vector<Subscript> subscripts;
     SymbolVector reversed;
     if (auto *aRef{std::get_if<ArrayRef>(&dataRef->u)}) {
       subscripts = std::move(aRef->subscript());
       reversed.push_back(aRef->GetLastSymbol());
       if (Component * component{aRef->base().UnwrapComponent()}) {
         dataRef = &component->base();
       } else {
         dataRef = nullptr;
       }
     }
     if (dataRef) {
       while (auto *component{std::get_if<Component>(&dataRef->u)}) {
         reversed.push_back(component->GetLastSymbol());
         dataRef = &component->base();
       }
       if (auto *baseSym{std::get_if<SymbolRef>(&dataRef->u)}) {
         reversed.push_back(*baseSym);
       } else {
         Say("Base of coindexed named object has subscripts or cosubscripts"_err_en_US);
       }
     }
     std::vector<Expr<SubscriptInteger>> cosubscripts;
     bool cosubsOk{true};
     for (const auto &cosub :
         std::get<std::list<parser::Cosubscript>>(x.imageSelector.t)) {
       MaybeExpr coex{Analyze(cosub)};
       if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(coex)}) {
         cosubscripts.push_back(
             ConvertToType<SubscriptInteger>(std::move(*intExpr)));
       } else {
         cosubsOk = false;
       }
     }
     if (cosubsOk && !reversed.empty()) {
       int numCosubscripts{static_cast<int>(cosubscripts.size())};
       const Symbol &symbol{reversed.front()};
       if (numCosubscripts != symbol.Corank()) {
         Say("'%s' has corank %d, but coindexed reference has %d cosubscripts"_err_en_US,
             symbol.name(), symbol.Corank(), numCosubscripts);
       }
     }
     for (const auto &imageSelSpec :
         std::get<std::list<parser::ImageSelectorSpec>>(x.imageSelector.t)) {
       std::visit(
           common::visitors{
               [&](const auto &x) { Analyze(x.v); },
           },
           imageSelSpec.u);
     }
     // Reverse the chain of symbols so that the base is first and coarray
     // ultimate component is last.
     if (cosubsOk) {
       return Designate(
           DataRef{CoarrayRef{SymbolVector{reversed.crbegin(), reversed.crend()},
               std::move(subscripts), std::move(cosubscripts)}});
     }
   }
   return std::nullopt;
 }
 
 int ExpressionAnalyzer::IntegerTypeSpecKind(
     const parser::IntegerTypeSpec &spec) {
   Expr<SubscriptInteger> value{
       AnalyzeKindSelector(TypeCategory::Integer, spec.v)};
   if (auto kind{ToInt64(value)}) {
     return static_cast<int>(*kind);
   }
   SayAt(spec, "Constant INTEGER kind value required here"_err_en_US);
   return GetDefaultKind(TypeCategory::Integer);
 }
 
 // Array constructors
 
 // Inverts a collection of generic ArrayConstructorValues<SomeType> that
 // all happen to have the same actual type T into one ArrayConstructor<T>.
 template <typename T>
 ArrayConstructorValues<T> MakeSpecific(
     ArrayConstructorValues<SomeType> &&from) {
   ArrayConstructorValues<T> to;
   for (ArrayConstructorValue<SomeType> &x : from) {
     std::visit(
         common::visitors{
             [&](common::CopyableIndirection<Expr<SomeType>> &&expr) {
               auto *typed{UnwrapExpr<Expr<T>>(expr.value())};
               to.Push(std::move(DEREF(typed)));
             },
             [&](ImpliedDo<SomeType> &&impliedDo) {
               to.Push(ImpliedDo<T>{impliedDo.name(),
                   std::move(impliedDo.lower()), std::move(impliedDo.upper()),
                   std::move(impliedDo.stride()),
                   MakeSpecific<T>(std::move(impliedDo.values()))});
             },
         },
         std::move(x.u));
   }
   return to;
 }
 
 class ArrayConstructorContext {
 public:
   ArrayConstructorContext(
       ExpressionAnalyzer &c, std::optional<DynamicTypeWithLength> &&t)
       : exprAnalyzer_{c}, type_{std::move(t)} {}
 
   void Add(const parser::AcValue &);
   MaybeExpr ToExpr();
 
   // These interfaces allow *this to be used as a type visitor argument to
   // common::SearchTypes() to convert the array constructor to a typed
   // expression in ToExpr().
   using Result = MaybeExpr;
   using Types = AllTypes;
   template <typename T> Result Test() {
     if (type_ && type_->category() == T::category) {
       if constexpr (T::category == TypeCategory::Derived) {
         if (type_->IsUnlimitedPolymorphic()) {
           return std::nullopt;
         } else {
           return AsMaybeExpr(ArrayConstructor<T>{type_->GetDerivedTypeSpec(),
               MakeSpecific<T>(std::move(values_))});
         }
       } else if (type_->kind() == T::kind) {
         if constexpr (T::category == TypeCategory::Character) {
           if (auto len{type_->LEN()}) {
             return AsMaybeExpr(ArrayConstructor<T>{
                 *std::move(len), MakeSpecific<T>(std::move(values_))});
           }
         } else {
           return AsMaybeExpr(
               ArrayConstructor<T>{MakeSpecific<T>(std::move(values_))});
         }
       }
     }
     return std::nullopt;
   }
 
 private:
   void Push(MaybeExpr &&);
 
   template <int KIND, typename A>
   std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
       const A &x) {
     if (MaybeExpr y{exprAnalyzer_.Analyze(x)}) {
       Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
       return ConvertToType<Type<TypeCategory::Integer, KIND>>(
           std::move(DEREF(intExpr)));
     }
     return std::nullopt;
   }
 
   // Nested array constructors all reference the same ExpressionAnalyzer,
   // which represents the nest of active implied DO loop indices.
   ExpressionAnalyzer &exprAnalyzer_;
   std::optional<DynamicTypeWithLength> type_;
   bool explicitType_{type_.has_value()};
   std::optional<std::int64_t> constantLength_;
   ArrayConstructorValues<SomeType> values_;
   bool messageDisplayedOnce{false};
 };
 
 void ArrayConstructorContext::Push(MaybeExpr &&x) {
   if (!x) {
     return;
   }
   if (auto dyType{x->GetType()}) {
     DynamicTypeWithLength xType{*dyType};
     if (Expr<SomeCharacter> * charExpr{UnwrapExpr<Expr<SomeCharacter>>(*x)}) {
       CHECK(xType.category() == TypeCategory::Character);
       xType.length =
           std::visit([](const auto &kc) { return kc.LEN(); }, charExpr->u);
     }
     if (!type_) {
       // If there is no explicit type-spec in an array constructor, the type
       // of the array is the declared type of all of the elements, which must
       // be well-defined and all match.
       // TODO: Possible language extension: use the most general type of
       // the values as the type of a numeric constructed array, convert all
       // of the other values to that type.  Alternative: let the first value
       // determine the type, and convert the others to that type.
       CHECK(!explicitType_);
       type_ = std::move(xType);
       constantLength_ = ToInt64(type_->length);
       values_.Push(std::move(*x));
     } else if (!explicitType_) {
       if (static_cast<const DynamicType &>(*type_) ==
           static_cast<const DynamicType &>(xType)) {
         values_.Push(std::move(*x));
         if (auto thisLen{ToInt64(xType.LEN())}) {
           if (constantLength_) {
             if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
                 *thisLen != *constantLength_) {
               exprAnalyzer_.Say(
                   "Character literal in array constructor without explicit "
                   "type has different length than earlier element"_en_US);
             }
             if (*thisLen > *constantLength_) {
               // Language extension: use the longest literal to determine the
               // length of the array constructor's character elements, not the
               // first, when there is no explicit type.
               *constantLength_ = *thisLen;
               type_->length = xType.LEN();
             }
           } else {
             constantLength_ = *thisLen;
             type_->length = xType.LEN();
           }
         }
       } else {
         if (!messageDisplayedOnce) {
           exprAnalyzer_.Say(
               "Values in array constructor must have the same declared type "
               "when no explicit type appears"_err_en_US); // C7110
           messageDisplayedOnce = true;
         }
       }
     } else {
       if (auto cast{ConvertToType(*type_, std::move(*x))}) {
         values_.Push(std::move(*cast));
       } else {
         exprAnalyzer_.Say(
             "Value in array constructor of type '%s' could not "
             "be converted to the type of the array '%s'"_err_en_US,
             x->GetType()->AsFortran(), type_->AsFortran()); // C7111, C7112
       }
     }
   }
 }
 
 void ArrayConstructorContext::Add(const parser::AcValue &x) {
   using IntType = ResultType<ImpliedDoIndex>;
   std::visit(
       common::visitors{
           [&](const parser::AcValue::Triplet &triplet) {
             // Transform l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_'
             std::optional<Expr<IntType>> lower{
                 GetSpecificIntExpr<IntType::kind>(std::get<0>(triplet.t))};
             std::optional<Expr<IntType>> upper{
                 GetSpecificIntExpr<IntType::kind>(std::get<1>(triplet.t))};
             std::optional<Expr<IntType>> stride{
                 GetSpecificIntExpr<IntType::kind>(std::get<2>(triplet.t))};
             if (lower && upper) {
               if (!stride) {
                 stride = Expr<IntType>{1};
               }
               if (!type_) {
                 type_ = DynamicTypeWithLength{IntType::GetType()};
               }
               auto v{std::move(values_)};
               parser::CharBlock anonymous;
               Push(Expr<SomeType>{
                   Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{anonymous}}}});
               std::swap(v, values_);
               values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
                   std::move(*upper), std::move(*stride), std::move(v)});
             }
           },
           [&](const common::Indirection<parser::Expr> &expr) {
             auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
                 expr.value().source)};
             if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
               if (auto exprType{v->GetType()}) {
                 if (exprType->IsUnlimitedPolymorphic()) {
                   exprAnalyzer_.Say(
                       "Cannot have an unlimited polymorphic value in an "
                       "array constructor"_err_en_US); // C7113
                 }
               }
               Push(std::move(*v));
             }
           },
           [&](const common::Indirection<parser::AcImpliedDo> &impliedDo) {
             const auto &control{
                 std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
             const auto &bounds{
                 std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
             exprAnalyzer_.Analyze(bounds.name);
             parser::CharBlock name{bounds.name.thing.thing.source};
             const Symbol *symbol{bounds.name.thing.thing.symbol};
             int kind{IntType::kind};
             if (const auto dynamicType{DynamicType::From(symbol)}) {
               kind = dynamicType->kind();
             }
             if (exprAnalyzer_.AddImpliedDo(name, kind)) {
               std::optional<Expr<IntType>> lower{
                   GetSpecificIntExpr<IntType::kind>(bounds.lower)};
               std::optional<Expr<IntType>> upper{
                   GetSpecificIntExpr<IntType::kind>(bounds.upper)};
               if (lower && upper) {
                 std::optional<Expr<IntType>> stride{
                     GetSpecificIntExpr<IntType::kind>(bounds.step)};
                 auto v{std::move(values_)};
                 for (const auto &value :
                     std::get<std::list<parser::AcValue>>(impliedDo.value().t)) {
                   Add(value);
                 }
                 if (!stride) {
                   stride = Expr<IntType>{1};
                 }
                 std::swap(v, values_);
                 values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
                     std::move(*upper), std::move(*stride), std::move(v)});
               }
               exprAnalyzer_.RemoveImpliedDo(name);
             } else {
               exprAnalyzer_.SayAt(name,
                   "Implied DO index is active in surrounding implied DO loop "
                   "and may not have the same name"_err_en_US); // C7115
             }
           },
       },
       x.u);
 }
 
 MaybeExpr ArrayConstructorContext::ToExpr() {
   return common::SearchTypes(std::move(*this));
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
   const parser::AcSpec &acSpec{array.v};
   ArrayConstructorContext acContext{*this, AnalyzeTypeSpec(acSpec.type)};
   for (const parser::AcValue &value : acSpec.values) {
     acContext.Add(value);
   }
   return acContext.ToExpr();
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::StructureConstructor &structure) {
   auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
   parser::CharBlock typeName{std::get<parser::Name>(parsedType.t).source};
   if (!parsedType.derivedTypeSpec) {
     return std::nullopt;
   }
   const auto &spec{*parsedType.derivedTypeSpec};
   const Symbol &typeSymbol{spec.typeSymbol()};
   if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) {
     return std::nullopt; // error recovery
   }
   const auto &typeDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
   const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())};
 
   if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796
     AttachDeclaration(Say(typeName,
                           "ABSTRACT derived type '%s' may not be used in a "
                           "structure constructor"_err_en_US,
                           typeName),
         typeSymbol); // C7114
   }
 
   // This iterator traverses all of the components in the derived type and its
   // parents.  The symbols for whole parent components appear after their
   // own components and before the components of the types that extend them.
   // E.g., TYPE :: A; REAL X; END TYPE
   //       TYPE, EXTENDS(A) :: B; REAL Y; END TYPE
   // produces the component list X, A, Y.
   // The order is important below because a structure constructor can
   // initialize X or A by name, but not both.
   auto components{semantics::OrderedComponentIterator{spec}};
   auto nextAnonymous{components.begin()};
 
   std::set<parser::CharBlock> unavailable;
   bool anyKeyword{false};
   StructureConstructor result{spec};
   bool checkConflicts{true}; // until we hit one
   auto &messages{GetContextualMessages()};
 
   for (const auto &component :
       std::get<std::list<parser::ComponentSpec>>(structure.t)) {
     const parser::Expr &expr{
         std::get<parser::ComponentDataSource>(component.t).v.value()};
     parser::CharBlock source{expr.source};
     auto restorer{messages.SetLocation(source)};
     const Symbol *symbol{nullptr};
     MaybeExpr value{Analyze(expr)};
     std::optional<DynamicType> valueType{DynamicType::From(value)};
     if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
       anyKeyword = true;
       source = kw->v.source;
       symbol = kw->v.symbol;
       if (!symbol) {
         auto componentIter{std::find_if(components.begin(), components.end(),
             [=](const Symbol &symbol) { return symbol.name() == source; })};
         if (componentIter != components.end()) {
           symbol = &*componentIter;
         }
       }
       if (!symbol) { // C7101
         Say(source,
             "Keyword '%s=' does not name a component of derived type '%s'"_err_en_US,
             source, typeName);
       }
     } else {
       if (anyKeyword) { // C7100
         Say(source,
             "Value in structure constructor lacks a component name"_err_en_US);
         checkConflicts = false; // stem cascade
       }
       // Here's a regrettably common extension of the standard: anonymous
       // initialization of parent components, e.g., T(PT(1)) rather than
       // T(1) or T(PT=PT(1)).
       if (nextAnonymous == components.begin() && parentComponent &&
           valueType == DynamicType::From(*parentComponent) &&
           context().IsEnabled(LanguageFeature::AnonymousParents)) {
         auto iter{
             std::find(components.begin(), components.end(), *parentComponent)};
         if (iter != components.end()) {
           symbol = parentComponent;
           nextAnonymous = ++iter;
           if (context().ShouldWarn(LanguageFeature::AnonymousParents)) {
             Say(source,
                 "Whole parent component '%s' in structure "
                 "constructor should not be anonymous"_en_US,
                 symbol->name());
           }
         }
       }
       while (!symbol && nextAnonymous != components.end()) {
         const Symbol &next{*nextAnonymous};
         ++nextAnonymous;
         if (!next.test(Symbol::Flag::ParentComp)) {
           symbol = &next;
         }
       }
       if (!symbol) {
         Say(source, "Unexpected value in structure constructor"_err_en_US);
       }
     }
     if (symbol) {
       if (const auto *currScope{context_.globalScope().FindScope(source)}) {
         if (auto msg{CheckAccessibleComponent(*currScope, *symbol)}) {
           Say(source, *msg);
         }
       }
       if (checkConflicts) {
         auto componentIter{
             std::find(components.begin(), components.end(), *symbol)};
         if (unavailable.find(symbol->name()) != unavailable.cend()) {
           // C797, C798
           Say(source,
               "Component '%s' conflicts with another component earlier in "
               "this structure constructor"_err_en_US,
               symbol->name());
         } else if (symbol->test(Symbol::Flag::ParentComp)) {
           // Make earlier components unavailable once a whole parent appears.
           for (auto it{components.begin()}; it != componentIter; ++it) {
             unavailable.insert(it->name());
           }
         } else {
           // Make whole parent components unavailable after any of their
           // constituents appear.
           for (auto it{componentIter}; it != components.end(); ++it) {
             if (it->test(Symbol::Flag::ParentComp)) {
               unavailable.insert(it->name());
             }
           }
         }
       }
       unavailable.insert(symbol->name());
       if (value) {
         if (symbol->has<semantics::ProcEntityDetails>()) {
           CHECK(IsPointer(*symbol));
         } else if (symbol->has<semantics::ObjectEntityDetails>()) {
           // C1594(4)
           const auto &innermost{context_.FindScope(expr.source)};
           if (const auto *pureProc{FindPureProcedureContaining(innermost)}) {
             if (const Symbol * pointer{FindPointerComponent(*symbol)}) {
               if (const Symbol *
                   object{FindExternallyVisibleObject(*value, *pureProc)}) {
                 if (auto *msg{Say(expr.source,
                         "Externally visible object '%s' may not be "
                         "associated with pointer component '%s' in a "
                         "pure procedure"_err_en_US,
                         object->name(), pointer->name())}) {
                   msg->Attach(object->name(), "Object declaration"_en_US)
                       .Attach(pointer->name(), "Pointer declaration"_en_US);
                 }
               }
             }
           }
         } else if (symbol->has<semantics::TypeParamDetails>()) {
           Say(expr.source,
               "Type parameter '%s' may not appear as a component "
               "of a structure constructor"_err_en_US,
               symbol->name());
           continue;
         } else {
           Say(expr.source,
               "Component '%s' is neither a procedure pointer "
               "nor a data object"_err_en_US,
               symbol->name());
           continue;
         }
         if (IsPointer(*symbol)) {
           semantics::CheckPointerAssignment(
               GetFoldingContext(), *symbol, *value); // C7104, C7105
           result.Add(*symbol, Fold(std::move(*value)));
         } else if (MaybeExpr converted{
                        ConvertToType(*symbol, std::move(*value))}) {
           if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
             if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
               if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
                 AttachDeclaration(
                     Say(expr.source,
                         "Rank-%d array value is not compatible with scalar component '%s'"_err_en_US,
                         GetRank(*valueShape), symbol->name()),
                     *symbol);
               } else if (CheckConformance(messages, *componentShape,
                              *valueShape, "component", "value")) {
                 if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0 &&
                     !IsExpandableScalar(*converted)) {
                   AttachDeclaration(
                       Say(expr.source,
                           "Scalar value cannot be expanded to shape of array component '%s'"_err_en_US,
                           symbol->name()),
                       *symbol);
                 } else {
                   result.Add(*symbol, std::move(*converted));
                 }
               }
             } else {
               Say(expr.source, "Shape of value cannot be determined"_err_en_US);
             }
           } else {
             AttachDeclaration(
                 Say(expr.source,
                     "Shape of component '%s' cannot be determined"_err_en_US,
                     symbol->name()),
                 *symbol);
           }
         } else if (IsAllocatable(*symbol) &&
             std::holds_alternative<NullPointer>(value->u)) {
           // NULL() with no arguments allowed by 7.5.10 para 6 for ALLOCATABLE
         } else if (auto symType{DynamicType::From(symbol)}) {
           if (valueType) {
             AttachDeclaration(
                 Say(expr.source,
                     "Value in structure constructor of type %s is "
                     "incompatible with component '%s' of type %s"_err_en_US,
                     valueType->AsFortran(), symbol->name(),
                     symType->AsFortran()),
                 *symbol);
           } else {
             AttachDeclaration(
                 Say(expr.source,
                     "Value in structure constructor is incompatible with "
                     " component '%s' of type %s"_err_en_US,
                     symbol->name(), symType->AsFortran()),
                 *symbol);
           }
         }
       }
     }
   }
 
   // Ensure that unmentioned component objects have default initializers.
   for (const Symbol &symbol : components) {
     if (!symbol.test(Symbol::Flag::ParentComp) &&
         unavailable.find(symbol.name()) == unavailable.cend() &&
         !IsAllocatable(symbol)) {
       if (const auto *details{
               symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
         if (details->init()) {
           result.Add(symbol, common::Clone(*details->init()));
         } else { // C799
           AttachDeclaration(Say(typeName,
                                 "Structure constructor lacks a value for "
                                 "component '%s'"_err_en_US,
                                 symbol.name()),
               symbol);
         }
       }
     }
   }
 
   return AsMaybeExpr(Expr<SomeDerived>{std::move(result)});
 }
 
 static std::optional<parser::CharBlock> GetPassName(
     const semantics::Symbol &proc) {
   return std::visit(
       [](const auto &details) {
         if constexpr (std::is_base_of_v<semantics::WithPassArg,
                           std::decay_t<decltype(details)>>) {
           return details.passName();
         } else {
           return std::optional<parser::CharBlock>{};
         }
       },
       proc.details());
 }
 
 static int GetPassIndex(const Symbol &proc) {
   CHECK(!proc.attrs().test(semantics::Attr::NOPASS));
   std::optional<parser::CharBlock> passName{GetPassName(proc)};
   const auto *interface{semantics::FindInterface(proc)};
   if (!passName || !interface) {
     return 0; // first argument is passed-object
   }
   const auto &subp{interface->get<semantics::SubprogramDetails>()};
   int index{0};
   for (const auto *arg : subp.dummyArgs()) {
     if (arg && arg->name() == passName) {
       return index;
     }
     ++index;
   }
   DIE("PASS argument name not in dummy argument list");
 }
 
 // Injects an expression into an actual argument list as the "passed object"
 // for a type-bound procedure reference that is not NOPASS.  Adds an
 // argument keyword if possible, but not when the passed object goes
 // before a positional argument.
 // e.g., obj%tbp(x) -> tbp(obj,x).
 static void AddPassArg(ActualArguments &actuals, const Expr<SomeDerived> &expr,
     const Symbol &component, bool isPassedObject = true) {
   if (component.attrs().test(semantics::Attr::NOPASS)) {
     return;
   }
   int passIndex{GetPassIndex(component)};
   auto iter{actuals.begin()};
   int at{0};
   while (iter < actuals.end() && at < passIndex) {
     if (*iter && (*iter)->keyword()) {
       iter = actuals.end();
       break;
     }
     ++iter;
     ++at;
   }
   ActualArgument passed{AsGenericExpr(common::Clone(expr))};
   passed.set_isPassedObject(isPassedObject);
   if (iter == actuals.end()) {
     if (auto passName{GetPassName(component)}) {
       passed.set_keyword(*passName);
     }
   }
   actuals.emplace(iter, std::move(passed));
 }
 
 // Return the compile-time resolution of a procedure binding, if possible.
 static const Symbol *GetBindingResolution(
     const std::optional<DynamicType> &baseType, const Symbol &component) {
   const auto *binding{component.detailsIf<semantics::ProcBindingDetails>()};
   if (!binding) {
     return nullptr;
   }
   if (!component.attrs().test(semantics::Attr::NON_OVERRIDABLE) &&
       (!baseType || baseType->IsPolymorphic())) {
     return nullptr;
   }
   return &binding->symbol();
 }
 
 auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
     const parser::ProcComponentRef &pcr, ActualArguments &&arguments)
     -> std::optional<CalleeAndArguments> {
   const parser::StructureComponent &sc{pcr.v.thing};
   if (MaybeExpr base{Analyze(sc.base)}) {
     if (const Symbol * sym{sc.component.symbol}) {
       if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
         if (sym->has<semantics::GenericDetails>()) {
           AdjustActuals adjustment{
               [&](const Symbol &proc, ActualArguments &actuals) {
                 if (!proc.attrs().test(semantics::Attr::NOPASS)) {
                   AddPassArg(actuals, std::move(*dtExpr), proc);
                 }
                 return true;
               }};
           sym = ResolveGeneric(*sym, arguments, adjustment);
           if (!sym) {
             EmitGenericResolutionError(*sc.component.symbol);
             return std::nullopt;
           }
         }
         if (const Symbol *
             resolution{GetBindingResolution(dtExpr->GetType(), *sym)}) {
           AddPassArg(arguments, std::move(*dtExpr), *sym, false);
           return CalleeAndArguments{
               ProcedureDesignator{*resolution}, std::move(arguments)};
         } else if (std::optional<DataRef> dataRef{
                        ExtractDataRef(std::move(*dtExpr))}) {
           if (sym->attrs().test(semantics::Attr::NOPASS)) {
             return CalleeAndArguments{
                 ProcedureDesignator{Component{std::move(*dataRef), *sym}},
                 std::move(arguments)};
           } else {
             AddPassArg(arguments,
                 Expr<SomeDerived>{Designator<SomeDerived>{std::move(*dataRef)}},
                 *sym);
             return CalleeAndArguments{
                 ProcedureDesignator{*sym}, std::move(arguments)};
           }
         }
       }
       Say(sc.component.source,
           "Base of procedure component reference is not a derived-type object"_err_en_US);
     }
   }
   CHECK(!GetContextualMessages().empty());
   return std::nullopt;
 }
 
 // Can actual be argument associated with dummy?
 static bool CheckCompatibleArgument(bool isElemental,
     const ActualArgument &actual, const characteristics::DummyArgument &dummy) {
   return std::visit(
       common::visitors{
           [&](const characteristics::DummyDataObject &x) {
             characteristics::TypeAndShape dummyTypeAndShape{x.type};
             if (!isElemental && actual.Rank() != dummyTypeAndShape.Rank()) {
               return false;
             } else if (auto actualType{actual.GetType()}) {
               return dummyTypeAndShape.type().IsTkCompatibleWith(*actualType);
             } else {
               return false;
             }
           },
           [&](const characteristics::DummyProcedure &) {
             const auto *expr{actual.UnwrapExpr()};
             return expr && IsProcedurePointer(*expr);
           },
           [&](const characteristics::AlternateReturn &) {
             return actual.isAlternateReturn();
           },
       },
       dummy.u);
 }
 
 // Are the actual arguments compatible with the dummy arguments of procedure?
 static bool CheckCompatibleArguments(
     const characteristics::Procedure &procedure,
     const ActualArguments &actuals) {
   bool isElemental{procedure.IsElemental()};
   const auto &dummies{procedure.dummyArguments};
   CHECK(dummies.size() == actuals.size());
   for (std::size_t i{0}; i < dummies.size(); ++i) {
     const characteristics::DummyArgument &dummy{dummies[i]};
     const std::optional<ActualArgument> &actual{actuals[i]};
     if (actual && !CheckCompatibleArgument(isElemental, *actual, dummy)) {
       return false;
     }
   }
   return true;
 }
 
 // Handles a forward reference to a module function from what must
 // be a specification expression.  Return false if the symbol is
 // an invalid forward reference.
 bool ExpressionAnalyzer::ResolveForward(const Symbol &symbol) {
   if (context_.HasError(symbol)) {
     return false;
   }
   if (const auto *details{
           symbol.detailsIf<semantics::SubprogramNameDetails>()}) {
     if (details->kind() == semantics::SubprogramKind::Module) {
       // If this symbol is still a SubprogramNameDetails, we must be
       // checking a specification expression in a sibling module
       // procedure.  Resolve its names now so that its interface
       // is known.
       semantics::ResolveSpecificationParts(context_, symbol);
       if (symbol.has<semantics::SubprogramNameDetails>()) {
         // When the symbol hasn't had its details updated, we must have
         // already been in the process of resolving the function's
         // specification part; but recursive function calls are not
         // allowed in specification parts (10.1.11 para 5).
         Say("The module function '%s' may not be referenced recursively in a specification expression"_err_en_US,
             symbol.name());
         context_.SetError(symbol);
         return false;
       }
     } else { // 10.1.11 para 4
       Say("The internal function '%s' may not be referenced in a specification expression"_err_en_US,
           symbol.name());
       context_.SetError(symbol);
       return false;
     }
   }
   return true;
 }
 
 // Resolve a call to a generic procedure with given actual arguments.
 // adjustActuals is called on procedure bindings to handle pass arg.
 const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
     const ActualArguments &actuals, const AdjustActuals &adjustActuals,
     bool mightBeStructureConstructor) {
   const Symbol *elemental{nullptr}; // matching elemental specific proc
   const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
   for (const Symbol &specific : details.specificProcs()) {
     if (!ResolveForward(specific)) {
       continue;
     }
     if (std::optional<characteristics::Procedure> procedure{
             characteristics::Procedure::Characterize(
                 ProcedureDesignator{specific}, context_.intrinsics())}) {
       ActualArguments localActuals{actuals};
       if (specific.has<semantics::ProcBindingDetails>()) {
         if (!adjustActuals.value()(specific, localActuals)) {
           continue;
         }
       }
       if (semantics::CheckInterfaceForGeneric(
               *procedure, localActuals, GetFoldingContext())) {
         if (CheckCompatibleArguments(*procedure, localActuals)) {
           if (!procedure->IsElemental()) {
             return &specific; // takes priority over elemental match
           }
           elemental = &specific;
         }
       }
     }
   }
   if (elemental) {
     return elemental;
   }
   // Check parent derived type
   if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
     if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
       if (extended->GetUltimate().has<semantics::GenericDetails>()) {
         if (const Symbol *
             result{ResolveGeneric(*extended, actuals, adjustActuals, false)}) {
           return result;
         }
       }
     }
   }
   if (mightBeStructureConstructor && details.derivedType()) {
     return details.derivedType();
   }
   return nullptr;
 }
 
 void ExpressionAnalyzer::EmitGenericResolutionError(const Symbol &symbol) {
   if (semantics::IsGenericDefinedOp(symbol)) {
     Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
         symbol.name());
   } else {
     Say("No specific procedure of generic '%s' matches the actual arguments"_err_en_US,
         symbol.name());
   }
 }
 
 auto ExpressionAnalyzer::GetCalleeAndArguments(
     const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
     bool isSubroutine, bool mightBeStructureConstructor)
     -> std::optional<CalleeAndArguments> {
   return std::visit(
       common::visitors{
           [&](const parser::Name &name) {
             return GetCalleeAndArguments(name, std::move(arguments),
                 isSubroutine, mightBeStructureConstructor);
           },
           [&](const parser::ProcComponentRef &pcr) {
             return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
           },
       },
       pd.u);
 }
 
 auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
     ActualArguments &&arguments, bool isSubroutine,
     bool mightBeStructureConstructor) -> std::optional<CalleeAndArguments> {
   const Symbol *symbol{name.symbol};
   if (context_.HasError(symbol)) {
     return std::nullopt; // also handles null symbol
   }
   const Symbol &ultimate{DEREF(symbol).GetUltimate()};
   if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
     if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
             CallCharacteristics{ultimate.name().ToString(), isSubroutine},
             arguments, GetFoldingContext())}) {
       return CalleeAndArguments{
           ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
           std::move(specificCall->arguments)};
     }
   } else {
     CheckForBadRecursion(name.source, ultimate);
     if (ultimate.has<semantics::GenericDetails>()) {
       ExpressionAnalyzer::AdjustActuals noAdjustment;
       symbol = ResolveGeneric(
           *symbol, arguments, noAdjustment, mightBeStructureConstructor);
     }
     if (symbol) {
       if (symbol->GetUltimate().has<semantics::DerivedTypeDetails>()) {
         if (mightBeStructureConstructor) {
           return CalleeAndArguments{
               semantics::SymbolRef{*symbol}, std::move(arguments)};
         }
       } else {
         return CalleeAndArguments{
             ProcedureDesignator{*symbol}, std::move(arguments)};
       }
     } else if (std::optional<SpecificCall> specificCall{
                    context_.intrinsics().Probe(
                        CallCharacteristics{
                            ultimate.name().ToString(), isSubroutine},
                        arguments, GetFoldingContext())}) {
       // Generics can extend intrinsics
       return CalleeAndArguments{
           ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
           std::move(specificCall->arguments)};
     } else {
       EmitGenericResolutionError(*name.symbol);
     }
   }
   return std::nullopt;
 }
 
 void ExpressionAnalyzer::CheckForBadRecursion(
     parser::CharBlock callSite, const semantics::Symbol &proc) {
   if (const auto *scope{proc.scope()}) {
     if (scope->sourceRange().Contains(callSite)) {
       parser::Message *msg{nullptr};
       if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
         msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
             callSite);
       } else if (IsAssumedLengthCharacter(proc) && IsExternal(proc)) {
         msg = Say( // 15.6.2.1(3)
             "Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
             callSite);
       }
       AttachDeclaration(msg, proc);
     }
   }
 }
 
 template <typename A> static const Symbol *AssumedTypeDummy(const A &x) {
   if (const auto *designator{
           std::get_if<common::Indirection<parser::Designator>>(&x.u)}) {
     if (const auto *dataRef{
             std::get_if<parser::DataRef>(&designator->value().u)}) {
       if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
         if (const Symbol * symbol{name->symbol}) {
           if (const auto *type{symbol->GetType()}) {
             if (type->category() == semantics::DeclTypeSpec::TypeStar) {
               return symbol;
             }
           }
         }
       }
     }
   }
   return nullptr;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
     std::optional<parser::StructureConstructor> *structureConstructor) {
   const parser::Call &call{funcRef.v};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
   ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
   for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
     analyzer.Analyze(arg, false /* not subroutine call */);
   }
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   }
   if (std::optional<CalleeAndArguments> callee{
           GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
               analyzer.GetActuals(), false /* not subroutine */,
               true /* might be structure constructor */)}) {
     if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
       return MakeFunctionRef(
           call.source, std::move(*proc), std::move(callee->arguments));
     } else if (structureConstructor) {
       // Structure constructor misparsed as function reference?
       CHECK(std::holds_alternative<semantics::SymbolRef>(callee->u));
       const Symbol &derivedType{*std::get<semantics::SymbolRef>(callee->u)};
       const auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
       if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
         semantics::Scope &scope{context_.FindScope(name->source)};
         semantics::DerivedTypeSpec dtSpec{
             name->source, derivedType.GetUltimate()};
         if (dtSpec.IsForwardReferenced()) {
           Say(call.source,
               "Cannot construct value for derived type '%s' "
               "before it is defined"_err_en_US,
               name->source);
           return std::nullopt;
         }
         const semantics::DeclTypeSpec &type{
             semantics::FindOrInstantiateDerivedType(
                 scope, std::move(dtSpec), context_)};
         auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)};
         *structureConstructor =
             mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec());
         return Analyze(structureConstructor->value());
       }
     }
   }
   return std::nullopt;
 }
 
 void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
   const parser::Call &call{callStmt.v};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
   ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
   const auto &actualArgList{std::get<std::list<parser::ActualArgSpec>>(call.t)};
   for (const auto &arg : actualArgList) {
     analyzer.Analyze(arg, true /* is subroutine call */);
   }
   if (!analyzer.fatalErrors()) {
     if (std::optional<CalleeAndArguments> callee{
             GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
                 analyzer.GetActuals(), true /* subroutine */)}) {
       ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
       CHECK(proc);
       if (CheckCall(call.source, *proc, callee->arguments)) {
         bool hasAlternateReturns{
             callee->arguments.size() < actualArgList.size()};
         callStmt.typedCall.Reset(
             new ProcedureRef{std::move(*proc), std::move(callee->arguments),
                 hasAlternateReturns},
             ProcedureRef::Deleter);
       }
     }
   }
 }
 
 const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
   if (!x.typedAssignment) {
     ArgumentAnalyzer analyzer{*this};
     analyzer.Analyze(std::get<parser::Variable>(x.t));
     analyzer.Analyze(std::get<parser::Expr>(x.t));
     if (analyzer.fatalErrors()) {
       x.typedAssignment.Reset(
           new GenericAssignmentWrapper{}, GenericAssignmentWrapper::Deleter);
     } else {
       std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
       Assignment assignment{
           Fold(analyzer.MoveExpr(0)), Fold(analyzer.MoveExpr(1))};
       if (procRef) {
         assignment.u = std::move(*procRef);
       }
       x.typedAssignment.Reset(
           new GenericAssignmentWrapper{std::move(assignment)},
           GenericAssignmentWrapper::Deleter);
     }
   }
   return common::GetPtrFromOptional(x.typedAssignment->v);
 }
 
 const Assignment *ExpressionAnalyzer::Analyze(
     const parser::PointerAssignmentStmt &x) {
   if (!x.typedAssignment) {
     MaybeExpr lhs{Analyze(std::get<parser::DataRef>(x.t))};
     MaybeExpr rhs{Analyze(std::get<parser::Expr>(x.t))};
     if (!lhs || !rhs) {
       x.typedAssignment.Reset(
           new GenericAssignmentWrapper{}, GenericAssignmentWrapper::Deleter);
     } else {
       Assignment assignment{std::move(*lhs), std::move(*rhs)};
       std::visit(common::visitors{
                      [&](const std::list<parser::BoundsRemapping> &list) {
                        Assignment::BoundsRemapping bounds;
                        for (const auto &elem : list) {
                          auto lower{AsSubscript(Analyze(std::get<0>(elem.t)))};
                          auto upper{AsSubscript(Analyze(std::get<1>(elem.t)))};
                          if (lower && upper) {
                            bounds.emplace_back(Fold(std::move(*lower)),
                                Fold(std::move(*upper)));
                          }
                        }
                        assignment.u = std::move(bounds);
                      },
                      [&](const std::list<parser::BoundsSpec> &list) {
                        Assignment::BoundsSpec bounds;
                        for (const auto &bound : list) {
                          if (auto lower{AsSubscript(Analyze(bound.v))}) {
                            bounds.emplace_back(Fold(std::move(*lower)));
                          }
                        }
                        assignment.u = std::move(bounds);
                      },
                  },
           std::get<parser::PointerAssignmentStmt::Bounds>(x.t).u);
       x.typedAssignment.Reset(
           new GenericAssignmentWrapper{std::move(assignment)},
           GenericAssignmentWrapper::Deleter);
     }
   }
   return common::GetPtrFromOptional(x.typedAssignment->v);
 }
 
 static bool IsExternalCalledImplicitly(
     parser::CharBlock callSite, const ProcedureDesignator &proc) {
   if (const auto *symbol{proc.GetSymbol()}) {
     return symbol->has<semantics::SubprogramDetails>() &&
         symbol->owner().IsGlobal() &&
         (!symbol->scope() /*ENTRY*/ ||
             !symbol->scope()->sourceRange().Contains(callSite));
   } else {
     return false;
   }
 }
 
 std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
     parser::CharBlock callSite, const ProcedureDesignator &proc,
     ActualArguments &arguments) {
   auto chars{
       characteristics::Procedure::Characterize(proc, context_.intrinsics())};
   if (chars) {
     bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
     if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
       Say(callSite,
           "References to the procedure '%s' require an explicit interface"_en_US,
           DEREF(proc.GetSymbol()).name());
     }
     semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
         context_.FindScope(callSite), treatExternalAsImplicit);
     const Symbol *procSymbol{proc.GetSymbol()};
     if (procSymbol && !IsPureProcedure(*procSymbol)) {
       if (const semantics::Scope *
           pure{semantics::FindPureProcedureContaining(
               context_.FindScope(callSite))}) {
         Say(callSite,
             "Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
             procSymbol->name(), DEREF(pure->symbol()).name());
       }
     }
   }
   return chars;
 }
 
 // Unary operations
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
   if (MaybeExpr operand{Analyze(x.v.value())}) {
     if (const semantics::Symbol * symbol{GetLastSymbol(*operand)}) {
       if (const semantics::Symbol * result{FindFunctionResult(*symbol)}) {
         if (semantics::IsProcedurePointer(*result)) {
           Say("A function reference that returns a procedure "
               "pointer may not be parenthesized"_err_en_US); // C1003
         }
       }
     }
     return Parenthesize(std::move(*operand));
   }
   return std::nullopt;
 }
 
 static MaybeExpr NumericUnaryHelper(ExpressionAnalyzer &context,
     NumericOperator opr, const parser::Expr::IntrinsicUnary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(x.v);
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   } else if (analyzer.IsIntrinsicNumeric(opr)) {
     if (opr == NumericOperator::Add) {
       return analyzer.MoveExpr(0);
     } else {
       return Negation(context.GetContextualMessages(), analyzer.MoveExpr(0));
     }
   } else {
     return analyzer.TryDefinedOp(AsFortran(opr),
         "Operand of unary %s must be numeric; have %s"_err_en_US);
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::UnaryPlus &x) {
   return NumericUnaryHelper(*this, NumericOperator::Add, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Negate &x) {
   return NumericUnaryHelper(*this, NumericOperator::Subtract, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
   ArgumentAnalyzer analyzer{*this};
   analyzer.Analyze(x.v);
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   } else if (analyzer.IsIntrinsicLogical()) {
     return AsGenericExpr(
         LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u)));
   } else {
     return analyzer.TryDefinedOp(LogicalOperator::Not,
         "Operand of %s must be LOGICAL; have %s"_err_en_US);
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
   // Represent %LOC() exactly as if it had been a call to the LOC() extension
   // intrinsic function.
   // Use the actual source for the name of the call for error reporting.
   std::optional<ActualArgument> arg;
   if (const Symbol * assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
     arg = ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
   } else if (MaybeExpr argExpr{Analyze(x.v.value())}) {
     arg = ActualArgument{std::move(*argExpr)};
   } else {
     return std::nullopt;
   }
   parser::CharBlock at{GetContextualMessages().at()};
   CHECK(at.size() >= 4);
   parser::CharBlock loc{at.begin() + 1, 3};
   CHECK(loc == "loc");
   return MakeFunctionRef(loc, ActualArguments{std::move(*arg)});
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
   const auto &name{std::get<parser::DefinedOpName>(x.t).v};
   ArgumentAnalyzer analyzer{*this, name.source};
   analyzer.Analyze(std::get<1>(x.t));
   return analyzer.TryDefinedOp(name.source.ToString().c_str(),
       "No operator %s defined for %s"_err_en_US, true);
 }
 
 // Binary (dyadic) operations
 
 template <template <typename> class OPR>
 MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
     const parser::Expr::IntrinsicBinary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   } else if (analyzer.IsIntrinsicNumeric(opr)) {
     analyzer.CheckConformance();
     return NumericOperation<OPR>(context.GetContextualMessages(),
         analyzer.MoveExpr(0), analyzer.MoveExpr(1),
         context.GetDefaultKind(TypeCategory::Real));
   } else {
     return analyzer.TryDefinedOp(AsFortran(opr),
         "Operands of %s must be numeric; have %s and %s"_err_en_US);
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) {
   return NumericBinaryHelper<Power>(*this, NumericOperator::Power, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Multiply &x) {
   return NumericBinaryHelper<Multiply>(*this, NumericOperator::Multiply, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Divide &x) {
   return NumericBinaryHelper<Divide>(*this, NumericOperator::Divide, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Add &x) {
   return NumericBinaryHelper<Add>(*this, NumericOperator::Add, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Subtract &x) {
   return NumericBinaryHelper<Subtract>(*this, NumericOperator::Subtract, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::Expr::ComplexConstructor &x) {
   auto re{Analyze(std::get<0>(x.t).value())};
   auto im{Analyze(std::get<1>(x.t).value())};
   if (re && im) {
     ConformabilityCheck(GetContextualMessages(), *re, *im);
   }
   return AsMaybeExpr(ConstructComplex(GetContextualMessages(), std::move(re),
       std::move(im), GetDefaultKind(TypeCategory::Real)));
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
   ArgumentAnalyzer analyzer{*this};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   } else if (analyzer.IsIntrinsicConcat()) {
     return std::visit(
         [&](auto &&x, auto &&y) -> MaybeExpr {
           using T = ResultType<decltype(x)>;
           if constexpr (std::is_same_v<T, ResultType<decltype(y)>>) {
             return AsGenericExpr(Concat<T::kind>{std::move(x), std::move(y)});
           } else {
             DIE("different types for intrinsic concat");
           }
         },
         std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(0).u).u),
         std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(1).u).u));
   } else {
     return analyzer.TryDefinedOp("//",
         "Operands of %s must be CHARACTER with the same kind; have %s and %s"_err_en_US);
   }
 }
 
 // The Name represents a user-defined intrinsic operator.
 // If the actuals match one of the specific procedures, return a function ref.
 // Otherwise report the error in messages.
 MaybeExpr ExpressionAnalyzer::AnalyzeDefinedOp(
     const parser::Name &name, ActualArguments &&actuals) {
   if (auto callee{GetCalleeAndArguments(name, std::move(actuals))}) {
     CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
     return MakeFunctionRef(name.source,
         std::move(std::get<ProcedureDesignator>(callee->u)),
         std::move(callee->arguments));
   } else {
     return std::nullopt;
   }
 }
 
 MaybeExpr RelationHelper(ExpressionAnalyzer &context, RelationalOperator opr,
     const parser::Expr::IntrinsicBinary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   } else {
     analyzer.ConvertBOZ(0, analyzer.GetType(1));
     analyzer.ConvertBOZ(1, analyzer.GetType(0));
     if (analyzer.IsIntrinsicRelational(opr)) {
       return AsMaybeExpr(Relate(context.GetContextualMessages(), opr,
           analyzer.MoveExpr(0), analyzer.MoveExpr(1)));
     } else {
       return analyzer.TryDefinedOp(opr,
           "Operands of %s must have comparable types; have %s and %s"_err_en_US);
     }
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LT &x) {
   return RelationHelper(*this, RelationalOperator::LT, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LE &x) {
   return RelationHelper(*this, RelationalOperator::LE, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::EQ &x) {
   return RelationHelper(*this, RelationalOperator::EQ, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NE &x) {
   return RelationHelper(*this, RelationalOperator::NE, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::GE &x) {
   return RelationHelper(*this, RelationalOperator::GE, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::GT &x) {
   return RelationHelper(*this, RelationalOperator::GT, x);
 }
 
 MaybeExpr LogicalBinaryHelper(ExpressionAnalyzer &context, LogicalOperator opr,
     const parser::Expr::IntrinsicBinary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
   if (analyzer.fatalErrors()) {
     return std::nullopt;
   } else if (analyzer.IsIntrinsicLogical()) {
     return AsGenericExpr(BinaryLogicalOperation(opr,
         std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u),
         std::get<Expr<SomeLogical>>(analyzer.MoveExpr(1).u)));
   } else {
     return analyzer.TryDefinedOp(
         opr, "Operands of %s must be LOGICAL; have %s and %s"_err_en_US);
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::AND &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::And, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::OR &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::Or, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::EQV &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::Eqv, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NEQV &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::Neqv, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
   const auto &name{std::get<parser::DefinedOpName>(x.t).v};
   ArgumentAnalyzer analyzer{*this, name.source};
   analyzer.Analyze(std::get<1>(x.t));
   analyzer.Analyze(std::get<2>(x.t));
   return analyzer.TryDefinedOp(name.source.ToString().c_str(),
       "No operator %s defined for %s and %s"_err_en_US, true);
 }
 
 static void CheckFuncRefToArrayElementRefHasSubscripts(
     semantics::SemanticsContext &context,
     const parser::FunctionReference &funcRef) {
   // Emit message if the function reference fix will end up an array element
   // reference with no subscripts because it will not be possible to later tell
   // the difference in expressions between empty subscript list due to bad
   // subscripts error recovery or because the user did not put any.
   if (std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t).empty()) {
     auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
     const auto *name{std::get_if<parser::Name>(&proc.u)};
     if (!name) {
       name = &std::get<parser::ProcComponentRef>(proc.u).v.thing.component;
     }
     auto &msg{context.Say(funcRef.v.source,
         name->symbol && name->symbol->Rank() == 0
             ? "'%s' is not a function"_err_en_US
             : "Reference to array '%s' with empty subscript list"_err_en_US,
         name->source)};
     if (name->symbol) {
       if (semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)) {
         msg.Attach(name->source,
             "A result variable must be declared with RESULT to allow recursive "
             "function calls"_en_US);
       } else {
         AttachDeclaration(&msg, *name->symbol);
       }
     }
   }
 }
 
 // Converts, if appropriate, an original misparse of ambiguous syntax like
 // A(1) as a function reference into an array reference.
 // Misparse structure constructors are detected elsewhere after generic
 // function call resolution fails.
 template <typename... A>
 static void FixMisparsedFunctionReference(
     semantics::SemanticsContext &context, const std::variant<A...> &constU) {
   // The parse tree is updated in situ when resolving an ambiguous parse.
   using uType = std::decay_t<decltype(constU)>;
   auto &u{const_cast<uType &>(constU)};
   if (auto *func{
           std::get_if<common::Indirection<parser::FunctionReference>>(&u)}) {
     parser::FunctionReference &funcRef{func->value()};
     auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
     if (Symbol *
         origSymbol{
             std::visit(common::visitors{
                            [&](parser::Name &name) { return name.symbol; },
                            [&](parser::ProcComponentRef &pcr) {
                              return pcr.v.thing.component.symbol;
                            },
                        },
                 proc.u)}) {
       Symbol &symbol{origSymbol->GetUltimate()};
       if (symbol.has<semantics::ObjectEntityDetails>() ||
           symbol.has<semantics::AssocEntityDetails>()) {
         // Note that expression in AssocEntityDetails cannot be a procedure
         // pointer as per C1105 so this cannot be a function reference.
         if constexpr (common::HasMember<common::Indirection<parser::Designator>,
                           uType>) {
           CheckFuncRefToArrayElementRefHasSubscripts(context, funcRef);
           u = common::Indirection{funcRef.ConvertToArrayElementRef()};
         } else {
           DIE("can't fix misparsed function as array reference");
         }
       }
     }
   }
 }
 
 // Common handling of parse tree node types that retain the
 // representation of the analyzed expression.
 template <typename PARSED>
 MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) {
   if (x.typedExpr) {
     return x.typedExpr->v;
   }
   if constexpr (std::is_same_v<PARSED, parser::Expr> ||
       std::is_same_v<PARSED, parser::Variable>) {
     FixMisparsedFunctionReference(context_, x.u);
   }
   if (AssumedTypeDummy(x)) { // C710
     Say("TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
   } else if (MaybeExpr result{evaluate::Fold(foldingContext_, Analyze(x.u))}) {
     SetExpr(x, std::move(*result));
     return x.typedExpr->v;
   }
   ResetExpr(x);
   if (!context_.AnyFatalError()) {
     std::string buf;
     llvm::raw_string_ostream dump{buf};
     parser::DumpTree(dump, x);
     Say("Internal error: Expression analysis failed on: %s"_err_en_US,
         dump.str());
   }
   fatalErrors_ = true;
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr &expr) {
   auto restorer{GetContextualMessages().SetLocation(expr.source)};
   return ExprOrVariable(expr);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Variable &variable) {
   auto restorer{GetContextualMessages().SetLocation(variable.GetSource())};
   return ExprOrVariable(variable);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtConstant &x) {
   auto restorer{GetContextualMessages().SetLocation(x.source)};
   return ExprOrVariable(x);
 }
 
 Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
     TypeCategory category,
     const std::optional<parser::KindSelector> &selector) {
   int defaultKind{GetDefaultKind(category)};
   if (!selector) {
     return Expr<SubscriptInteger>{defaultKind};
   }
   return std::visit(
       common::visitors{
           [&](const parser::ScalarIntConstantExpr &x) {
             if (MaybeExpr kind{Analyze(x)}) {
               Expr<SomeType> folded{Fold(std::move(*kind))};
               if (std::optional<std::int64_t> code{ToInt64(folded)}) {
                 if (CheckIntrinsicKind(category, *code)) {
                   return Expr<SubscriptInteger>{*code};
                 }
               } else if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(folded)}) {
                 return ConvertToType<SubscriptInteger>(std::move(*intExpr));
               }
             }
             return Expr<SubscriptInteger>{defaultKind};
           },
           [&](const parser::KindSelector::StarSize &x) {
             std::intmax_t size = x.v;
             if (!CheckIntrinsicSize(category, size)) {
               size = defaultKind;
             } else if (category == TypeCategory::Complex) {
               size /= 2;
             }
             return Expr<SubscriptInteger>{size};
           },
       },
       selector->u);
 }
 
 int ExpressionAnalyzer::GetDefaultKind(common::TypeCategory category) {
   return context_.GetDefaultKind(category);
 }
 
 DynamicType ExpressionAnalyzer::GetDefaultKindOfType(
     common::TypeCategory category) {
   return {category, GetDefaultKind(category)};
 }
 
 bool ExpressionAnalyzer::CheckIntrinsicKind(
     TypeCategory category, std::int64_t kind) {
   if (IsValidKindOfIntrinsicType(category, kind)) { // C712, C714, C715, C727
     return true;
   } else {
     Say("%s(KIND=%jd) is not a supported type"_err_en_US,
         ToUpperCase(EnumToString(category)), kind);
     return false;
   }
 }
 
 bool ExpressionAnalyzer::CheckIntrinsicSize(
     TypeCategory category, std::int64_t size) {
   if (category == TypeCategory::Complex) {
     // COMPLEX*16 == COMPLEX(KIND=8)
     if (size % 2 == 0 && IsValidKindOfIntrinsicType(category, size / 2)) {
       return true;
     }
   } else if (IsValidKindOfIntrinsicType(category, size)) {
     return true;
   }
   Say("%s*%jd is not a supported type"_err_en_US,
       ToUpperCase(EnumToString(category)), size);
   return false;
 }
 
 bool ExpressionAnalyzer::AddImpliedDo(parser::CharBlock name, int kind) {
   return impliedDos_.insert(std::make_pair(name, kind)).second;
 }
 
 void ExpressionAnalyzer::RemoveImpliedDo(parser::CharBlock name) {
   auto iter{impliedDos_.find(name)};
   if (iter != impliedDos_.end()) {
     impliedDos_.erase(iter);
   }
 }
 
 std::optional<int> ExpressionAnalyzer::IsImpliedDo(
     parser::CharBlock name) const {
   auto iter{impliedDos_.find(name)};
   if (iter != impliedDos_.cend()) {
     return {iter->second};
   } else {
     return std::nullopt;
   }
 }
 
 bool ExpressionAnalyzer::EnforceTypeConstraint(parser::CharBlock at,
     const MaybeExpr &result, TypeCategory category, bool defaultKind) {
   if (result) {
     if (auto type{result->GetType()}) {
       if (type->category() != category) { // C885
         Say(at, "Must have %s type, but is %s"_err_en_US,
             ToUpperCase(EnumToString(category)),
             ToUpperCase(type->AsFortran()));
         return false;
       } else if (defaultKind) {
         int kind{context_.GetDefaultKind(category)};
         if (type->kind() != kind) {
           Say(at, "Must have default kind(%d) of %s type, but is %s"_err_en_US,
               kind, ToUpperCase(EnumToString(category)),
               ToUpperCase(type->AsFortran()));
           return false;
         }
       }
     } else {
       Say(at, "Must have %s type, but is typeless"_err_en_US,
           ToUpperCase(EnumToString(category)));
       return false;
     }
   }
   return true;
 }
 
 MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
     ProcedureDesignator &&proc, ActualArguments &&arguments) {
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&proc.u)}) {
     if (intrinsic->name == "null" && arguments.empty()) {
       return Expr<SomeType>{NullPointer{}};
     }
   }
   if (const Symbol * symbol{proc.GetSymbol()}) {
     if (!ResolveForward(*symbol)) {
       return std::nullopt;
     }
   }
   if (auto chars{CheckCall(callSite, proc, arguments)}) {
     if (chars->functionResult) {
       const auto &result{*chars->functionResult};
       if (result.IsProcedurePointer()) {
         return Expr<SomeType>{
             ProcedureRef{std::move(proc), std::move(arguments)}};
       } else {
         // Not a procedure pointer, so type and shape are known.
         return TypedWrapper<FunctionRef, ProcedureRef>(
             DEREF(result.GetTypeAndShape()).type(),
             ProcedureRef{std::move(proc), std::move(arguments)});
       }
     }
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
     parser::CharBlock intrinsic, ActualArguments &&arguments) {
   if (std::optional<SpecificCall> specificCall{
           context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
               arguments, context_.foldingContext())}) {
     return MakeFunctionRef(intrinsic,
         ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
         std::move(specificCall->arguments));
   } else {
     return std::nullopt;
   }
 }
 
 void ArgumentAnalyzer::Analyze(const parser::Variable &x) {
   source_.ExtendToCover(x.GetSource());
   if (MaybeExpr expr{context_.Analyze(x)}) {
     if (!IsConstantExpr(*expr)) {
       actuals_.emplace_back(std::move(*expr));
       return;
     }
     const Symbol *symbol{GetLastSymbol(*expr)};
     if (!symbol) {
       context_.SayAt(x, "Assignment to constant '%s' is not allowed"_err_en_US,
           x.GetSource());
     } else if (auto *subp{symbol->detailsIf<semantics::SubprogramDetails>()}) {
       auto *msg{context_.SayAt(x,
           "Assignment to subprogram '%s' is not allowed"_err_en_US,
           symbol->name())};
       if (subp->isFunction()) {
         const auto &result{subp->result().name()};
         msg->Attach(result, "Function result is '%s'"_err_en_US, result);
       }
     } else {
       context_.SayAt(x, "Assignment to constant '%s' is not allowed"_err_en_US,
           symbol->name());
     }
   }
   fatalErrors_ = true;
 }
 
 void ArgumentAnalyzer::Analyze(
     const parser::ActualArgSpec &arg, bool isSubroutine) {
-  // TODO: C1002: Allow a whole assumed-size array to appear if the dummy
-  // argument would accept it.  Handle by special-casing the context
-  // ActualArg -> Variable -> Designator.
   // TODO: Actual arguments that are procedures and procedure pointers need to
   // be detected and represented (they're not expressions).
   // TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
   std::optional<ActualArgument> actual;
   bool isAltReturn{false};
   std::visit(common::visitors{
                  [&](const common::Indirection<parser::Expr> &x) {
                    // TODO: Distinguish & handle procedure name and
                    // proc-component-ref
                    actual = AnalyzeExpr(x.value());
                  },
                  [&](const parser::AltReturnSpec &) {
                    if (!isSubroutine) {
                      context_.Say(
                          "alternate return specification may not appear on"
                          " function reference"_err_en_US);
                    }
                    isAltReturn = true;
                  },
                  [&](const parser::ActualArg::PercentRef &) {
                    context_.Say("TODO: %REF() argument"_err_en_US);
                  },
                  [&](const parser::ActualArg::PercentVal &) {
                    context_.Say("TODO: %VAL() argument"_err_en_US);
                  },
              },
       std::get<parser::ActualArg>(arg.t).u);
   if (actual) {
     if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
       actual->set_keyword(argKW->v.source);
     }
     actuals_.emplace_back(std::move(*actual));
   } else if (!isAltReturn) {
     fatalErrors_ = true;
   }
 }
 
 bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const {
   CHECK(actuals_.size() == 2);
   return semantics::IsIntrinsicRelational(
       opr, *GetType(0), GetRank(0), *GetType(1), GetRank(1));
 }
 
 bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
   std::optional<DynamicType> type0{GetType(0)};
   if (actuals_.size() == 1) {
     if (IsBOZLiteral(0)) {
       return opr == NumericOperator::Add;
     } else {
       return type0 && semantics::IsIntrinsicNumeric(*type0);
     }
   } else {
     std::optional<DynamicType> type1{GetType(1)};
     if (IsBOZLiteral(0) && type1) {
       auto cat1{type1->category()};
       return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real;
     } else if (IsBOZLiteral(1) && type0) { // Integer/Real opr BOZ
       auto cat0{type0->category()};
       return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
     } else {
       return type0 && type1 &&
           semantics::IsIntrinsicNumeric(*type0, GetRank(0), *type1, GetRank(1));
     }
   }
 }
 
 bool ArgumentAnalyzer::IsIntrinsicLogical() const {
   if (actuals_.size() == 1) {
     return semantics::IsIntrinsicLogical(*GetType(0));
     return GetType(0)->category() == TypeCategory::Logical;
   } else {
     return semantics::IsIntrinsicLogical(
         *GetType(0), GetRank(0), *GetType(1), GetRank(1));
   }
 }
 
 bool ArgumentAnalyzer::IsIntrinsicConcat() const {
   return semantics::IsIntrinsicConcat(
       *GetType(0), GetRank(0), *GetType(1), GetRank(1));
 }
 
 bool ArgumentAnalyzer::CheckConformance() const {
   if (actuals_.size() == 2) {
     const auto *lhs{actuals_.at(0).value().UnwrapExpr()};
     const auto *rhs{actuals_.at(1).value().UnwrapExpr()};
     if (lhs && rhs) {
       auto &foldingContext{context_.GetFoldingContext()};
       auto lhShape{GetShape(foldingContext, *lhs)};
       auto rhShape{GetShape(foldingContext, *rhs)};
       if (lhShape && rhShape) {
         return evaluate::CheckConformance(foldingContext.messages(), *lhShape,
             *rhShape, "left operand", "right operand");
       }
     }
   }
   return true; // no proven problem
 }
 
 MaybeExpr ArgumentAnalyzer::TryDefinedOp(
     const char *opr, parser::MessageFixedText &&error, bool isUserOp) {
   if (AnyUntypedOperand()) {
     context_.Say(
         std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
     return std::nullopt;
   }
   {
     auto restorer{context_.GetContextualMessages().DiscardMessages()};
     std::string oprNameString{
         isUserOp ? std::string{opr} : "operator("s + opr + ')'};
     parser::CharBlock oprName{oprNameString};
     const auto &scope{context_.context().FindScope(source_)};
     if (Symbol * symbol{scope.FindSymbol(oprName)}) {
       parser::Name name{symbol->name(), symbol};
       if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
         return result;
       }
       sawDefinedOp_ = symbol;
     }
     for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
       if (const Symbol * symbol{FindBoundOp(oprName, passIndex)}) {
         if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
           return result;
         }
       }
     }
   }
   if (sawDefinedOp_) {
     SayNoMatch(ToUpperCase(sawDefinedOp_->name().ToString()));
   } else if (actuals_.size() == 1 || AreConformable()) {
     context_.Say(
         std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
   } else {
     context_.Say(
         "Operands of %s are not conformable; have rank %d and rank %d"_err_en_US,
         ToUpperCase(opr), actuals_[0]->Rank(), actuals_[1]->Rank());
   }
   return std::nullopt;
 }
 
 MaybeExpr ArgumentAnalyzer::TryDefinedOp(
     std::vector<const char *> oprs, parser::MessageFixedText &&error) {
   for (std::size_t i{1}; i < oprs.size(); ++i) {
     auto restorer{context_.GetContextualMessages().DiscardMessages()};
     if (auto result{TryDefinedOp(oprs[i], std::move(error))}) {
       return result;
     }
   }
   return TryDefinedOp(oprs[0], std::move(error));
 }
 
 MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) {
   ActualArguments localActuals{actuals_};
   const Symbol *proc{GetBindingResolution(GetType(passIndex), symbol)};
   if (!proc) {
     proc = &symbol;
     localActuals.at(passIndex).value().set_isPassedObject();
   }
   CheckConformance();
   return context_.MakeFunctionRef(
       source_, ProcedureDesignator{*proc}, std::move(localActuals));
 }
 
 std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
   using semantics::Tristate;
   const Expr<SomeType> &lhs{GetExpr(0)};
   const Expr<SomeType> &rhs{GetExpr(1)};
   std::optional<DynamicType> lhsType{lhs.GetType()};
   std::optional<DynamicType> rhsType{rhs.GetType()};
   int lhsRank{lhs.Rank()};
   int rhsRank{rhs.Rank()};
   Tristate isDefined{
       semantics::IsDefinedAssignment(lhsType, lhsRank, rhsType, rhsRank)};
   if (isDefined == Tristate::No) {
     if (lhsType && rhsType) {
       AddAssignmentConversion(*lhsType, *rhsType);
     }
     return std::nullopt; // user-defined assignment not allowed for these args
   }
   auto restorer{context_.GetContextualMessages().SetLocation(source_)};
   if (std::optional<ProcedureRef> procRef{GetDefinedAssignmentProc()}) {
     context_.CheckCall(source_, procRef->proc(), procRef->arguments());
     return std::move(*procRef);
   }
   if (isDefined == Tristate::Yes) {
     if (!lhsType || !rhsType || (lhsRank != rhsRank && rhsRank != 0) ||
         !OkLogicalIntegerAssignment(lhsType->category(), rhsType->category())) {
       SayNoMatch("ASSIGNMENT(=)", true);
     }
   }
   return std::nullopt;
 }
 
 bool ArgumentAnalyzer::OkLogicalIntegerAssignment(
     TypeCategory lhs, TypeCategory rhs) {
   if (!context_.context().languageFeatures().IsEnabled(
           common::LanguageFeature::LogicalIntegerAssignment)) {
     return false;
   }
   std::optional<parser::MessageFixedText> msg;
   if (lhs == TypeCategory::Integer && rhs == TypeCategory::Logical) {
     // allow assignment to LOGICAL from INTEGER as a legacy extension
     msg = "nonstandard usage: assignment of LOGICAL to INTEGER"_en_US;
   } else if (lhs == TypeCategory::Logical && rhs == TypeCategory::Integer) {
     // ... and assignment to LOGICAL from INTEGER
     msg = "nonstandard usage: assignment of INTEGER to LOGICAL"_en_US;
   } else {
     return false;
   }
   if (context_.context().languageFeatures().ShouldWarn(
           common::LanguageFeature::LogicalIntegerAssignment)) {
     context_.Say(std::move(*msg));
   }
   return true;
 }
 
 std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
   auto restorer{context_.GetContextualMessages().DiscardMessages()};
   std::string oprNameString{"assignment(=)"};
   parser::CharBlock oprName{oprNameString};
   const Symbol *proc{nullptr};
   const auto &scope{context_.context().FindScope(source_)};
   if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
     if (const Symbol *
         specific{context_.ResolveGeneric(*symbol, actuals_, noAdjustment)}) {
       proc = specific;
     } else {
       context_.EmitGenericResolutionError(*symbol);
     }
   }
   int passedObjectIndex{-1};
   for (std::size_t i{0}; i < actuals_.size(); ++i) {
     if (const Symbol * specific{FindBoundOp(oprName, i)}) {
       if (const Symbol *
           resolution{GetBindingResolution(GetType(i), *specific)}) {
         proc = resolution;
       } else {
         proc = specific;
         passedObjectIndex = i;
       }
     }
   }
   if (!proc) {
     return std::nullopt;
   }
   ActualArguments actualsCopy{actuals_};
   if (passedObjectIndex >= 0) {
     actualsCopy[passedObjectIndex]->set_isPassedObject();
   }
   return ProcedureRef{ProcedureDesignator{*proc}, std::move(actualsCopy)};
 }
 
 void ArgumentAnalyzer::Dump(llvm::raw_ostream &os) {
   os << "source_: " << source_.ToString() << " fatalErrors_ = " << fatalErrors_
      << '\n';
   for (const auto &actual : actuals_) {
     if (!actual.has_value()) {
       os << "- error\n";
     } else if (const Symbol * symbol{actual->GetAssumedTypeDummy()}) {
       os << "- assumed type: " << symbol->name().ToString() << '\n';
     } else if (const Expr<SomeType> *expr{actual->UnwrapExpr()}) {
       expr->AsFortran(os << "- expr: ") << '\n';
     } else {
       DIE("bad ActualArgument");
     }
   }
 }
+
 std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
     const parser::Expr &expr) {
   source_.ExtendToCover(expr.source);
   if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
     expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter);
     if (isProcedureCall_) {
       return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
-    } else {
-      context_.SayAt(expr.source,
-          "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
-      return std::nullopt;
     }
-  } else if (MaybeExpr argExpr{context_.Analyze(expr)}) {
-    if (!isProcedureCall_ && IsProcedure(*argExpr)) {
-      if (IsFunction(*argExpr)) {
-        context_.SayAt(
-            expr.source, "Function call must have argument list"_err_en_US);
-      } else {
-        context_.SayAt(
-            expr.source, "Subroutine name is not allowed here"_err_en_US);
-      }
-      return std::nullopt;
+    context_.SayAt(expr.source,
+        "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
+  } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) {
+    if (isProcedureCall_ || !IsProcedure(*argExpr)) {
+      return ActualArgument{context_.Fold(std::move(*argExpr))};
+    }
+    context_.SayAt(expr.source,
+        IsFunction(*argExpr) ? "Function call must have argument list"_err_en_US
+                             : "Subroutine name is not allowed here"_err_en_US);
+  }
+  return std::nullopt;
+}
+
+MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
+    const parser::Expr &expr) {
+  // If an expression's parse tree is a whole assumed-size array:
+  //   Expr -> Designator -> DataRef -> Name
+  // treat it as a special case for argument passing and bypass
+  // the C1002/C1014 constraint checking in expression semantics.
+  if (const auto *name{parser::Unwrap<parser::Name>(expr)}) {
+    if (name->symbol && semantics::IsAssumedSizeArray(*name->symbol)) {
+      auto restorer{context_.AllowWholeAssumedSizeArray()};
+      return context_.Analyze(expr);
     }
-    return ActualArgument{context_.Fold(std::move(*argExpr))};
-  } else {
-    return std::nullopt;
   }
+  return context_.Analyze(expr);
 }
 
 bool ArgumentAnalyzer::AreConformable() const {
   CHECK(!fatalErrors_ && actuals_.size() == 2);
   return evaluate::AreConformable(*actuals_[0], *actuals_[1]);
 }
 
 // Look for a type-bound operator in the type of arg number passIndex.
 const Symbol *ArgumentAnalyzer::FindBoundOp(
     parser::CharBlock oprName, int passIndex) {
   const auto *type{GetDerivedTypeSpec(GetType(passIndex))};
   if (!type || !type->scope()) {
     return nullptr;
   }
   const Symbol *symbol{type->scope()->FindComponent(oprName)};
   if (!symbol) {
     return nullptr;
   }
   sawDefinedOp_ = symbol;
   ExpressionAnalyzer::AdjustActuals adjustment{
       [&](const Symbol &proc, ActualArguments &) {
         return passIndex == GetPassIndex(proc);
       }};
   const Symbol *result{context_.ResolveGeneric(*symbol, actuals_, adjustment)};
   if (!result) {
     context_.EmitGenericResolutionError(*symbol);
   }
   return result;
 }
 
 // If there is an implicit conversion between intrinsic types, make it explicit
 void ArgumentAnalyzer::AddAssignmentConversion(
     const DynamicType &lhsType, const DynamicType &rhsType) {
   if (lhsType.category() == rhsType.category() &&
       lhsType.kind() == rhsType.kind()) {
     // no conversion necessary
   } else if (auto rhsExpr{evaluate::ConvertToType(lhsType, MoveExpr(1))}) {
     actuals_[1] = ActualArgument{*rhsExpr};
   } else {
     actuals_[1] = std::nullopt;
   }
 }
 
 std::optional<DynamicType> ArgumentAnalyzer::GetType(std::size_t i) const {
   return i < actuals_.size() ? actuals_[i].value().GetType() : std::nullopt;
 }
 int ArgumentAnalyzer::GetRank(std::size_t i) const {
   return i < actuals_.size() ? actuals_[i].value().Rank() : 0;
 }
 
 // If the argument at index i is a BOZ literal, convert its type to match the
 // otherType.  It it's REAL convert to REAL, otherwise convert to INTEGER.
 // Note that IBM supports comparing BOZ literals to CHARACTER operands.  That
 // is not currently supported.
 void ArgumentAnalyzer::ConvertBOZ(
     std::size_t i, std::optional<DynamicType> otherType) {
   if (IsBOZLiteral(i)) {
     Expr<SomeType> &&argExpr{MoveExpr(i)};
     auto *boz{std::get_if<BOZLiteralConstant>(&argExpr.u)};
     if (otherType && otherType->category() == TypeCategory::Real) {
       MaybeExpr realExpr{ConvertToKind<TypeCategory::Real>(
           context_.context().GetDefaultKind(TypeCategory::Real),
           std::move(*boz))};
       actuals_[i] = std::move(*realExpr);
     } else {
       MaybeExpr intExpr{ConvertToKind<TypeCategory::Integer>(
           context_.context().GetDefaultKind(TypeCategory::Integer),
           std::move(*boz))};
       actuals_[i] = std::move(*intExpr);
     }
   }
 }
 
 // Report error resolving opr when there is a user-defined one available
 void ArgumentAnalyzer::SayNoMatch(const std::string &opr, bool isAssignment) {
   std::string type0{TypeAsFortran(0)};
   auto rank0{actuals_[0]->Rank()};
   if (actuals_.size() == 1) {
     if (rank0 > 0) {
       context_.Say("No intrinsic or user-defined %s matches "
                    "rank %d array of %s"_err_en_US,
           opr, rank0, type0);
     } else {
       context_.Say("No intrinsic or user-defined %s matches "
                    "operand type %s"_err_en_US,
           opr, type0);
     }
   } else {
     std::string type1{TypeAsFortran(1)};
     auto rank1{actuals_[1]->Rank()};
     if (rank0 > 0 && rank1 > 0 && rank0 != rank1) {
       context_.Say("No intrinsic or user-defined %s matches "
                    "rank %d array of %s and rank %d array of %s"_err_en_US,
           opr, rank0, type0, rank1, type1);
     } else if (isAssignment && rank0 != rank1) {
       if (rank0 == 0) {
         context_.Say("No intrinsic or user-defined %s matches "
                      "scalar %s and rank %d array of %s"_err_en_US,
             opr, type0, rank1, type1);
       } else {
         context_.Say("No intrinsic or user-defined %s matches "
                      "rank %d array of %s and scalar %s"_err_en_US,
             opr, rank0, type0, type1);
       }
     } else {
       context_.Say("No intrinsic or user-defined %s matches "
                    "operand types %s and %s"_err_en_US,
           opr, type0, type1);
     }
   }
 }
 
 std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) {
   if (std::optional<DynamicType> type{GetType(i)}) {
     return type->category() == TypeCategory::Derived
         ? "TYPE("s + type->AsFortran() + ')'
         : type->category() == TypeCategory::Character
         ? "CHARACTER(KIND="s + std::to_string(type->kind()) + ')'
         : ToUpperCase(type->AsFortran());
   } else {
     return "untyped";
   }
 }
 
 bool ArgumentAnalyzer::AnyUntypedOperand() {
   for (const auto &actual : actuals_) {
     if (!actual.value().GetType()) {
       return true;
     }
   }
   return false;
 }
 
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
     SemanticsContext &context, common::TypeCategory category,
     const std::optional<parser::KindSelector> &selector) {
   evaluate::ExpressionAnalyzer analyzer{context};
   auto restorer{
       analyzer.GetContextualMessages().SetLocation(context.location().value())};
   return analyzer.AnalyzeKindSelector(category, selector);
 }
 
 void AnalyzeCallStmt(SemanticsContext &context, const parser::CallStmt &call) {
   evaluate::ExpressionAnalyzer{context}.Analyze(call);
 }
 
 const evaluate::Assignment *AnalyzeAssignmentStmt(
     SemanticsContext &context, const parser::AssignmentStmt &stmt) {
   return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
 }
 const evaluate::Assignment *AnalyzePointerAssignmentStmt(
     SemanticsContext &context, const parser::PointerAssignmentStmt &stmt) {
   return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
 }
 
 ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}
 
 bool ExprChecker::Pre(const parser::DataImpliedDo &ido) {
   parser::Walk(std::get<parser::DataImpliedDo::Bounds>(ido.t), *this);
   const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
   auto name{bounds.name.thing.thing};
   int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
   if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
     if (dynamicType->category() == TypeCategory::Integer) {
       kind = dynamicType->kind();
     }
   }
   exprAnalyzer_.AddImpliedDo(name.source, kind);
   parser::Walk(std::get<std::list<parser::DataIDoObject>>(ido.t), *this);
   exprAnalyzer_.RemoveImpliedDo(name.source);
   return false;
 }
 
 bool ExprChecker::Walk(const parser::Program &program) {
   parser::Walk(program, *this);
   return !context_.AnyFatalError();
 }
 } // namespace Fortran::semantics
diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index fb47f6dceab9..1aa87d34af98 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -1,143 +1,143 @@
 ! RUN: %S/test_errors.sh %s %t %f18
 ! 9.4.5
 subroutine s1
   type :: t(k, l)
     integer, kind :: k
     integer, len :: l
   end type
   type(t(1, 2)) :: x
   !ERROR: Assignment to constant 'x%k' is not allowed
   x%k = 4
   !ERROR: Left-hand side of assignment is not modifiable
   x%l = 3
 end
 
 ! C901
 subroutine s2(x)
   !ERROR: A dummy argument may not also be a named constant
   real, parameter :: x = 0.0
   real, parameter :: a(*) = [1, 2, 3]
   character, parameter :: c(2) = "ab"
   integer :: i
   !ERROR: Assignment to constant 'x' is not allowed
   x = 2.0
   i = 2
   !ERROR: Left-hand side of assignment is not modifiable
   a(i) = 3.0
   !ERROR: Left-hand side of assignment is not modifiable
   a(i:i+1) = [4, 5]
   !ERROR: Left-hand side of assignment is not modifiable
   c(i:2) = "cd"
 end
 
 ! C901
 subroutine s3
   type :: t
     integer :: a(2)
     integer :: b
   end type
   type(t) :: x
   type(t), parameter :: y = t([1,2], 3)
   integer :: i = 1
   x%a(i) = 1
   !ERROR: Left-hand side of assignment is not modifiable
   y%a(i) = 2
   x%b = 4
   !ERROR: Assignment to constant 'y%b' is not allowed
   y%b = 5
 end
 
 ! C844
 subroutine s4
   type :: t
     integer :: a(2)
   end type
 contains
   subroutine s(x, c)
     type(t), intent(in) :: x
     character(10), intent(in) :: c
     type(t) :: y
     !ERROR: Left-hand side of assignment is not modifiable
     x = y
     !ERROR: Left-hand side of assignment is not modifiable
     x%a(1) = 2
     !ERROR: Left-hand side of assignment is not modifiable
     c(2:3) = "ab"
   end
 end
 
 ! 8.5.15(2)
 module m5
   real :: x
   real, protected :: y
   real, private :: z
   type :: t
     real :: a
   end type
   type(t), protected :: b
 end
 subroutine s5()
   use m5
   implicit none
   x = 1.0
   !ERROR: Left-hand side of assignment is not modifiable
   y = 2.0
   !ERROR: No explicit type declared for 'z'
   z = 3.0
   !ERROR: Left-hand side of assignment is not modifiable
   b%a = 1.0
 end
 
 subroutine s6(x)
   integer :: x(*)
   x(1:3) = [1, 2, 3]
   x(:3) = [1, 2, 3]
   !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value
   x(:) = [1, 2, 3]
-  !ERROR: Left-hand side of assignment may not be a whole assumed-size array
+  !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
   x = [1, 2, 3]
 end
 
 module m7
   type :: t
     integer :: i
   end type
 contains
   subroutine s7(x)
     type(t) :: x(*)
     x(:3)%i = [1, 2, 3]
-    !ERROR: Left-hand side of assignment may not be a whole assumed-size array
+    !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
     x%i = [1, 2, 3]
   end
 end
 
 subroutine s7
   integer :: a(10), v(10)
   a(v(:)) = 1  ! vector subscript is ok
 end
 
 subroutine s8
   !ERROR: Assignment to subprogram 's8' is not allowed
   s8 = 1.0
 end
 
 real function f9() result(r)
   !ERROR: Assignment to subprogram 'f9' is not allowed
   f9 = 1.0
 end
 
 !ERROR: No explicit type declared for 'n'
 subroutine s10(a, n)
   implicit none
   real a(n)
   a(1:n) = 0.0  ! should not get a second error here
 end
 
 subroutine s11
   intrinsic :: sin
   real :: a
   !ERROR: Function call must have argument list
   a = sin
   !ERROR: Subroutine name is not allowed here
   a = s11
 end
diff --git a/flang/test/Semantics/io03.f90 b/flang/test/Semantics/io03.f90
index 5eb3420d1aea..e93646bf37ba 100644
--- a/flang/test/Semantics/io03.f90
+++ b/flang/test/Semantics/io03.f90
@@ -1,183 +1,183 @@
 ! RUN: %S/test_errors.sh %s %t %f18
   character(kind=1,len=50) internal_file
   character(kind=2,len=50) internal_file2
   character(kind=4,len=50) internal_file4
   character(kind=1,len=50) internal_fileA(20)
   character(kind=1,len=111) msg
   character(20) advance
   character(20) :: cvar;
   character, parameter :: const_internal_file = "(I6)"
   character, parameter :: const_cvar = "Ceci n'est pas une pipe."
   integer*1 stat1
   integer*2 stat2, id2
   integer*8 stat8
   integer :: iunit = 10
   integer, parameter :: junit = 11, const_size = 13, const_int = 15
   integer :: vv(10) = 7
 
   namelist /mmm/ mm1, mm2
   namelist /nnn/ nn1, nn2
 
   advance='no'
 
   open(10)
 
   read*
   print*, 'Ok'
   read(*)
   read*, jj
   read(*, *) jj
   read(unit=*, *) jj
   read(*, fmt=*) jj
   read(*, '(I4)') jj
   read(*, fmt='(I4)') jj
   read(fmt='(I4)', unit=*) jj
   read(iunit, *) jj
   read(junit, *) jj
   read(10, *) jj, cvar, cvar(7:17)
   read(internal_file, *) jj
   read(internal_fileA(3), *) jj
   read(internal_fileA(4:9), *) jj
   read(10, nnn)
   read(internal_file, nnn)
   read(internal_file, nml=nnn)
   read(const_internal_file, *)
   read(fmt=*, unit=internal_file)
   read(nml=nnn, unit=internal_file)
   read(iunit, nnn)
   read(10, nml=nnn)
   read(10, asynchronous='no') jj
   read(10, asynchronous='yes') jj
   read(10, eor=9, advance='no', fmt='(I4)') jj
   read(10, eor=9, advance='no', fmt='(I4)') jj
   read(10, asynchronous='yes', id=id) jj
   read(10, '(I4)', advance='no', asynchronous='yes', blank='null', &
       decimal='comma', end=9, eor=9, err=9, id=id, iomsg=msg, iostat=stat2, &
       pad='no', round='processor_defined', size=kk) jj
 
   !ERROR: Invalid character kind for an internal file variable
   read(internal_file2, *) jj
 
   !ERROR: Invalid character kind for an internal file variable
   read(internal_file4, *) jj
 
   !ERROR: Internal file must not have a vector subscript
   read(internal_fileA(vv), *) jj
 
   !ERROR: Input variable 'const_int' must be definable
   read(11, *) const_int
 
   !ERROR: SIZE variable 'const_size' must be definable
   read(11, pos=ipos, size=const_size, end=9)
 
   !ERROR: Input variable 'const_cvar' must be definable
   read(11, *) const_cvar
 
   !ERROR: Input variable 'const_cvar' must be definable
   read(11, *) const_cvar(3:13)
 
   !ERROR: Duplicate IOSTAT specifier
   read(11, pos=ipos, iostat=stat1, iostat=stat2)
 
   !ERROR: Duplicate END specifier
   read(11, end=9, pos=ipos, end=9)
 
   !ERROR: Duplicate NML specifier
   read(10, nml=mmm, nml=nnn)
 
   !ERROR: READ statement must have a UNIT specifier
   read(err=9, iostat=stat8) jj
 
   !ERROR: READ statement must not have a DELIM specifier
   !ERROR: READ statement must not have a SIGN specifier
   read(10, delim='quote', sign='plus') jj
 
   !ERROR: If NML appears, REC must not appear
   read(10, nnn, rec=nn)
 
   !ERROR: If NML appears, FMT must not appear
   !ERROR: If NML appears, a data list must not appear
   read(10, fmt=*, nml=nnn) jj
 
   !ERROR: If UNIT=* appears, REC must not appear
   read(*, rec=13)
 
   !ERROR: If UNIT=* appears, POS must not appear
   read(*, pos=13)
 
   !ERROR: If UNIT=internal-file appears, REC must not appear
   read(internal_file, rec=13)
 
   !ERROR: If UNIT=internal-file appears, POS must not appear
   read(internal_file, pos=13)
 
   !ERROR: If REC appears, END must not appear
   read(10, fmt='(I4)', end=9, rec=13) jj
 
   !ERROR: If REC appears, FMT=* must not appear
   read(10, *, rec=13) jj
 
   !ERROR: If ADVANCE appears, UNIT=internal-file must not appear
   read(internal_file, '(I4)', eor=9, advance='no') jj
 
   !ERROR: If ADVANCE appears, an explicit format must also appear
   !ERROR: If EOR appears, ADVANCE with value 'NO' must also appear
   read(10, eor=9, advance='yes')
 
   !ERROR: If EOR appears, ADVANCE with value 'NO' must also appear
   read(10, eor=9)
 
   !ERROR: Invalid ASYNCHRONOUS value 'nay'
   read(10, asynchronous='nay') ! prog req
 
   !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
   read(*, asynchronous='yes')
 
   !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
   read(internal_file, asynchronous='y'//'es')
 
   !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
   read(10, id=id)
 
   !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
   read(10, asynchronous='n'//'o', id=id)
 
   !ERROR: If POS appears, REC must not appear
   read(10, pos=13, rec=13) jj
 
   !ERROR: If DECIMAL appears, FMT or NML must also appear
   !ERROR: If BLANK appears, FMT or NML must also appear
   !ERROR: Invalid DECIMAL value 'Punkt'
   read(10, decimal='Punkt', blank='null') jj
 
   !ERROR: If ROUND appears, FMT or NML must also appear
   !ERROR: If PAD appears, FMT or NML must also appear
   read(10, pad='no', round='nearest') jj
 
   !ERROR: ID kind (2) is smaller than default INTEGER kind (4)
   read(10, id=id2, asynchronous='yes') jj
 
 9 continue
 end
 
 subroutine s(aa, n)
   integer :: aa(5,*)
   integer, intent(in) :: n
   integer :: bb(10), vv(10)
   type tt
     real :: x, y, z
   end type tt
   type(tt) :: qq(20)
 
   vv = 1
 
   read(*, *) aa(n,1)
   read(*, *) aa(n:n+2,2)
   read(*, *) qq(2:5)%y
 
   !ERROR: Input variable 'n' must be definable
   read(*, *) n
 
-  !ERROR: Whole assumed size array 'aa' may not be an input item
+  !ERROR: Whole assumed-size array 'aa' may not appear here without subscripts
   read(*, *) aa
 end