[flang] Finer control over error recovery with GetExpr()

[klausler]

Summary

Prior to this patch, the semantics utility GetExpr() will crash
unconditionally if it encounters a typed expression in the parse
tree that has not been set by expression semantics. This is the
right behavior when called from lowering, by which time it is known
that the program had no fatal user errors, since it signifies a
fatal internal error. However, prior to lowering, in the statement
semantics checking code, a more nuanced test should be used before
crashing -- specifically, we should not crash in the face of a
missing typed expression when in error recovery mode.

Getting this right requires GetExpr() and its helper class to have
access to the semantics context, so that it can check AnyFatalErrors()
before crashing. So this patch touches nearly all of its call sites.

flang/include/flang/Semantics/tools.h

 
 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 
 bool ExprHasTypeCategory(
     const SomeExpr &expr, const common::TypeCategory &type);
 bool ExprTypeKindIsDefault(
     const SomeExpr &expr, const SemanticsContext &context);
 
-struct GetExprHelper {
+class GetExprHelper {
+public:
+  explicit GetExprHelper(SemanticsContext *context) : context_{context} {}
+  GetExprHelper() : crashIfNoExpr_{true} {}
+
   // Specializations for parse tree nodes that have a typedExpr member.
-  static const SomeExpr *Get(const parser::Expr &);
-  static const SomeExpr *Get(const parser::Variable &);
-  static const SomeExpr *Get(const parser::DataStmtConstant &);
-  static const SomeExpr *Get(const parser::AllocateObject &);
-  static const SomeExpr *Get(const parser::PointerObject &);
+  const SomeExpr *Get(const parser::Expr &);
+  const SomeExpr *Get(const parser::Variable &);
+  const SomeExpr *Get(const parser::DataStmtConstant &);
+  const SomeExpr *Get(const parser::AllocateObject &);
+  const SomeExpr *Get(const parser::PointerObject &);
 
-  template <typename T>
-  static const SomeExpr *Get(const common::Indirection<T> &x) {
+  template <typename T> const SomeExpr *Get(const common::Indirection<T> &x) {
     return Get(x.value());
   }
-  template <typename T> static const SomeExpr *Get(const std::optional<T> &x) {
+  template <typename T> const SomeExpr *Get(const std::optional<T> &x) {
     return x ? Get(*x) : nullptr;
   }
-  template <typename T> static const SomeExpr *Get(const T &x) {
+  template <typename T> const SomeExpr *Get(const T &x) {
     static_assert(
         !parser::HasTypedExpr<T>::value, "explicit Get overload must be added");
     if constexpr (ConstraintTrait<T>) {
       return Get(x.thing);
     } else if constexpr (WrapperTrait<T>) {
       return Get(x.v);
     } else {
       return nullptr;
     }
   }
+
+private:
+  SemanticsContext *context_{nullptr};
+  const bool crashIfNoExpr_{false};
 };
 
+// If a SemanticsContext is passed, even if null, it is possible for a null
+// pointer to be returned in the event of an expression that had fatal errors.
+// Use these first two forms in semantics checks for best error recovery.
+// If a SemanticsContext is not passed, a missing expression will
+// cause a crash.
+template <typename T>
+const SomeExpr *GetExpr(SemanticsContext *context, const T &x) {
+  return GetExprHelper{context}.Get(x);
+}
+template <typename T>
+const SomeExpr *GetExpr(SemanticsContext &context, const T &x) {
+  return GetExprHelper{&context}.Get(x);
+}
 template <typename T> const SomeExpr *GetExpr(const T &x) {
   return GetExprHelper{}.Get(x);
 }
 
 const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &);
 const evaluate::Assignment *GetAssignment(
     const parser::PointerAssignmentStmt &);
 
 template <typename T> std::optional<std::int64_t> GetIntValue(const T &x) {
-  if (const auto *expr{GetExpr(x)}) {
+  if (const auto *expr{GetExpr(nullptr, x)}) {
     return evaluate::ToInt64(*expr);
   } else {
     return std::nullopt;
   }
 }
 
 template <typename T> bool IsZero(const T &expr) {
   auto value{GetIntValue(expr)};

flang/lib/Semantics/assignment.cpp

for (std::size_t i{0}; i < size; ++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));
+  CheckShape(expr.thing.value().source, GetExpr(context_, expr));
   ++whereDepth_;
 }
 
 void AssignmentContext::PopWhereContext() {
   --whereDepth_;
   if (whereDepth_ == 0) {
     whereExtents_.clear();
   }

flang/lib/Semantics/check-allocate.cpp

std::visit(
         allocOpt.u);
   }
 
   if (stopCheckingAllocate) {
     return std::nullopt;
   }
 
   if (info.gotSource || info.gotMold) {
-    if (const auto *expr{GetExpr(DEREF(parserSourceExpr))}) {
+    if (const auto *expr{GetExpr(context, DEREF(parserSourceExpr))}) {
       parser::CharBlock at{parserSourceExpr->source};
       info.sourceExprType = expr->GetType();
       if (!info.sourceExprType) {
         context.Say(at,
             "Typeless item not allowed as SOURCE or MOLD in ALLOCATE"_err_en_US);
         return std::nullopt;
       }
       info.sourceExprRank = expr->Rank();

flang/lib/Semantics/check-arithmeticif.cpp

 
 void ArithmeticIfStmtChecker::Leave(
     const parser::ArithmeticIfStmt &arithmeticIfStmt) {
   // Arithmetic IF statements have been removed from Fortran 2018.
   // The constraints and requirements here refer to the 2008 spec.
   // R853 Check for a scalar-numeric-expr
   // C849 that shall not be of type complex.
   auto &parsedExpr{std::get<parser::Expr>(arithmeticIfStmt.t)};
-  if (const auto *expr{GetExpr(parsedExpr)}) {
+  if (const auto *expr{GetExpr(context_, parsedExpr)}) {
     if (expr->Rank() > 0) {
       context_.Say(parsedExpr.source,
           "ARITHMETIC IF expression must be a scalar expression"_err_en_US);
     } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Complex)) {
       context_.Say(parsedExpr.source,
           "ARITHMETIC IF expression must not be a COMPLEX expression"_err_en_US);
     } else if (!IsNumericExpr(*expr)) {
       context_.Say(parsedExpr.source,

flang/lib/Semantics/check-case.cpp

 };
 
 void CaseChecker::Enter(const parser::CaseConstruct &construct) {
   const auto &selectCaseStmt{
       std::get<parser::Statement<parser::SelectCaseStmt>>(construct.t)};
   const auto &selectCase{selectCaseStmt.statement};
   const auto &selectExpr{
       std::get<parser::Scalar<parser::Expr>>(selectCase.t).thing};
-  const auto *x{GetExpr(selectExpr)};
+  const auto *x{GetExpr(context_, selectExpr)};
   if (!x) {
     return; // expression semantics failed
   }
   if (auto exprType{x->GetType()}) {
     const auto &caseList{
         std::get<std::list<parser::CaseConstruct::Case>>(construct.t)};
     switch (exprType->category()) {
     case TypeCategory::Integer:

flang/lib/Semantics/check-coarray.cpp

private:
   SemanticsContext &context_;
   std::set<parser::Label> labels_;
   parser::CharBlock currentStatementSourcePosition_;
   parser::CharBlock criticalSourcePosition_;
 };
 
 template <typename T>
 static void CheckTeamType(SemanticsContext &context, const T &x) {
-  if (const auto *expr{GetExpr(x)}) {
+  if (const auto *expr{GetExpr(context, x)}) {
     if (!IsTeamType(evaluate::GetDerivedTypeSpec(expr->GetType()))) {
       context.Say(parser::FindSourceLocation(x), // C1114
           "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
     }
   }
 }
 
 static void CheckTeamStat(

flang/lib/Semantics/check-deallocate.cpp

std::visit(
                     "name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
               } else {
                 context_.CheckIndexVarRedefine(name);
               }
             },
             [&](const parser::StructureComponent &structureComponent) {
               // Only perform structureComponent checks it was successfully
               // analyzed in expression analysis.
-              if (GetExpr(allocateObject)) {
+              if (GetExpr(context_, allocateObject)) {
                 if (!IsAllocatableOrPointer(
                         *structureComponent.component.symbol)) { // C932
                   context_.Say(structureComponent.component.source,
                       "component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
                 }
               }
             },
         },

flang/lib/Semantics/check-do-forall.cpp

if (const Symbol * symbol{scalarName.thing.symbol}) {
           }
         }
       } // No messages for INTEGER
     }
   }
 
   // Semantic checks for the limit and step expressions
   void CheckDoExpression(const parser::ScalarExpr &scalarExpression) {
-    if (const SomeExpr * expr{GetExpr(scalarExpression)}) {
+    if (const SomeExpr * expr{GetExpr(context_, scalarExpression)}) {
       if (!ExprHasTypeCategory(*expr, TypeCategory::Integer)) {
         // No warnings or errors for type INTEGER
         const parser::CharBlock &loc{scalarExpression.thing.value().source};
         CheckDoControl(loc, ExprHasTypeCategory(*expr, TypeCategory::Real));
       }
     }
   }
 
for (const auto &ls : localitySpecs) {
             symbols.insert(ResolveAssociations(*symbol));
           }
         }
       }
     }
     return symbols;
   }
 
-  static UnorderedSymbolSet GatherSymbolsFromExpression(
-      const parser::Expr &expression) {
+  UnorderedSymbolSet GatherSymbolsFromExpression(
+      const parser::Expr &expression) const {
     UnorderedSymbolSet result;
-    if (const auto *expr{GetExpr(expression)}) {
+    if (const auto *expr{GetExpr(context_, expression)}) {
       for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
         result.insert(ResolveAssociations(symbol));
       }
     }
     return result;
   }
 
   // C1121 - procedures in mask must be pure

 
 template ActualArgumentSet CollectActualArguments(const SomeExpr &);
 
 void DoForallChecker::Enter(const parser::Expr &parsedExpr) { ++exprDepth_; }
 
 void DoForallChecker::Leave(const parser::Expr &parsedExpr) {
   CHECK(exprDepth_ > 0);
   if (--exprDepth_ == 0) { // Only check top level expressions
-    if (const SomeExpr * expr{GetExpr(parsedExpr)}) {
+    if (const SomeExpr * expr{GetExpr(context_, parsedExpr)}) {
       ActualArgumentSet argSet{CollectActualArguments(*expr)};
       for (const evaluate::ActualArgumentRef &argRef : argSet) {
         CheckIfArgIsDoVar(*argRef, parsedExpr.source, context_);
       }
     }
   }
 }
 

flang/lib/Semantics/check-io.h

private:
   // Presence flag values.
   ENUM_CLASS(Flag, IoControlList, InternalUnit, NumberUnit, StarUnit, CharFmt,
       LabelFmt, StarFmt, AssignFmt, FmtOrNml, KnownAccess, AccessDirect,
       AccessStream, AdvanceYes, AsynchronousYes, KnownStatus, StatusNew,
       StatusReplace, StatusScratch, DataList)
 
   template <typename R, typename T> std::optional<R> GetConstExpr(const T &x) {
     using DefaultCharConstantType = evaluate::Ascii;
-    if (const SomeExpr * expr{GetExpr(x)}) {
+    if (const SomeExpr * expr{GetExpr(context_, x)}) {
       const auto foldExpr{
           evaluate::Fold(context_.foldingContext(), common::Clone(*expr))};
       if constexpr (std::is_same_v<R, std::string>) {
         return evaluate::GetScalarConstantValue<DefaultCharConstantType>(
             foldExpr);
       } else {
         static_assert(std::is_same_v<R, std::int64_t>, "unexpected type");
         return evaluate::ToInt64(foldExpr);

flang/lib/Semantics/check-io.cpp

 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)};
+            const SomeExpr *expr{GetExpr(context_, format)};
             if (!expr) {
               return;
             }
             auto type{expr->GetType()};
             if (type && type->category() == TypeCategory::Integer &&
                 type->kind() ==
                     context_.defaultKinds().GetDefaultKind(type->category()) &&
                 expr->Rank() == 0) {
std::visit(
       },
       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)};
+  const auto *expr{GetExpr(context_, 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(
void IoChecker::Enter(const parser::IoControlSpec::Size &var) {
   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 (const auto *expr{GetExpr(context_, *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);
       }
void IoChecker::Enter(const parser::MsgVariable &var) {
   }
   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 (const auto *expr{GetExpr(context_, *x)}) {
       if (evaluate::IsBOZLiteral(*expr)) {
         context_.Say(parser::FindSourceLocation(*x), // C7109
             "Output item must not be a BOZ literal constant"_err_en_US);
       }
       const Symbol *last{GetLastSymbol(*expr)};
       if (last && IsProcedurePointer(*last)) {
         context_.Say(parser::FindSourceLocation(*x),
             "Output item must not be a procedure pointer"_err_en_US); // C1233

flang/lib/Semantics/check-nullify.cpp

std::visit(
               } else if (!IsPointer(*symbol)) { // C951
                 messages.Say(name.source,
                     "name in NULLIFY statement must have the POINTER attribute"_err_en_US);
               } else if (pure) {
                 CheckDefinabilityInPureScope(messages, *symbol, scope, *pure);
               }
             },
             [&](const parser::StructureComponent &structureComponent) {
-              if (const auto *checkedExpr{GetExpr(pointerObject)}) {
+              if (const auto *checkedExpr{GetExpr(context_, pointerObject)}) {
                 if (!IsPointer(*structureComponent.component.symbol)) { // C951
                   messages.Say(structureComponent.component.source,
                       "component in NULLIFY statement must have the POINTER attribute"_err_en_US);
                 } else if (pure) {
                   if (const Symbol * symbol{GetFirstSymbol(*checkedExpr)}) {
                     CheckDefinabilityInPureScope(
                         messages, *symbol, scope, *pure);
                   }

flang/lib/Semantics/check-omp-structure.cpp

OmpWorkshareBlockChecker(SemanticsContext &context, parser::CharBlock source)
       : context_{context}, source_{source} {}
 
   template <typename T> bool Pre(const T &) { return true; }
   template <typename T> void Post(const T &) {}
 
   bool Pre(const parser::AssignmentStmt &assignment) {
     const auto &var{std::get<parser::Variable>(assignment.t)};
     const auto &expr{std::get<parser::Expr>(assignment.t)};
-    const auto *lhs{GetExpr(var)};
-    const auto *rhs{GetExpr(expr)};
+    const auto *lhs{GetExpr(context_, var)};
+    const auto *rhs{GetExpr(context_, expr)};
     if (lhs && rhs) {
       Tristate isDefined{semantics::IsDefinedAssignment(
           lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
       if (isDefined == Tristate::Yes) {
         context_.Say(expr.source,
             "Defined assignment statement is not "
             "allowed in a WORKSHARE construct"_err_en_US);
       }
     }
     return true;
   }
 
   bool Pre(const parser::Expr &expr) {
-    if (const auto *e{GetExpr(expr)}) {
+    if (const auto *e{GetExpr(context_, expr)}) {
       for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
         const Symbol &root{GetAssociationRoot(symbol)};
         if (IsFunction(root) &&
             !(root.attrs().test(Attr::ELEMENTAL) ||
                 root.attrs().test(Attr::INTRINSIC))) {
           context_.Say(expr.source,
               "User defined non-ELEMENTAL function "
               "'%s' is not allowed in a WORKSHARE construct"_err_en_US,
std::visit(
                       std::get_if<Fortran::common::Indirection<
                           Fortran::parser::Designator>>(&var.u)) {
                 const auto &varDesignator = varDesignatorIndirection->value();
                 if (const auto *dataRef = std::get_if<Fortran::parser::DataRef>(
                         &varDesignator.u)) {
                   if (const auto *name =
                           std::get_if<Fortran::parser::Name>(&dataRef->u)) {
                     const auto &varSymbol = *name->symbol;
-                    if (const auto *e{GetExpr(expr)}) {
+                    if (const auto *e{GetExpr(context_, expr)}) {
                       for (const Symbol &symbol :
                           evaluate::CollectSymbols(*e)) {
                         if (symbol == varSymbol) {
                           foundMatch = true;
                           break;
                         }
                       }
                     }

flang/lib/Semantics/check-stop.cpp

 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/tools.h"
 #include <optional>
 
 namespace Fortran::semantics {
 
 void StopChecker::Enter(const parser::StopStmt &stmt) {
   const auto &stopCode{std::get<std::optional<parser::StopCode>>(stmt.t)};
-  if (const auto *expr{GetExpr(stopCode)}) {
+  if (const auto *expr{GetExpr(context_, stopCode)}) {
     const parser::CharBlock &source{parser::FindSourceLocation(stopCode)};
     if (ExprHasTypeCategory(*expr, common::TypeCategory::Integer)) {
       // C1171 default kind
       if (!ExprTypeKindIsDefault(*expr, context_)) {
         context_.Say(
             source, "INTEGER stop code must be of default kind"_err_en_US);
       }
     } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Character)) {

flang/lib/Semantics/data-to-inits.cpp

 static constexpr bool removeOriginalInits{false};
 
 namespace Fortran::semantics {
 
 // Steps through a list of values in a DATA statement set; implements
 // repetition.
 template <typename DSV = parser::DataStmtValue> class ValueListIterator {
 public:
-  explicit ValueListIterator(const std::list<DSV> &list)
-      : end_{list.end()}, at_{list.begin()} {
+  ValueListIterator(SemanticsContext &context, const std::list<DSV> &list)
+      : context_{context}, end_{list.end()}, at_{list.begin()} {
     SetRepetitionCount();
   }
   bool hasFatalError() const { return hasFatalError_; }
   bool IsAtEnd() const { return at_ == end_; }
-  const SomeExpr *operator*() const { return GetExpr(GetConstant()); }
+  const SomeExpr *operator*() const { return GetExpr(context_, GetConstant()); }
   parser::CharBlock LocateSource() const { return GetConstant().source; }
   ValueListIterator &operator++() {
     if (repetitionsRemaining_ > 0) {
       --repetitionsRemaining_;
     } else if (at_ != end_) {
       ++at_;
       SetRepetitionCount();
     }
     return *this;
   }
 
 private:
   using listIterator = typename std::list<DSV>::const_iterator;
   void SetRepetitionCount();
   const parser::DataStmtValue &GetValue() const {
     return DEREF(common::Unwrap<const parser::DataStmtValue>(*at_));
   }
   const parser::DataStmtConstant &GetConstant() const {
     return std::get<parser::DataStmtConstant>(GetValue().t);
   }
 
+  SemanticsContext &context_;
   listIterator end_, at_;
   ConstantSubscript repetitionsRemaining_{0};
   bool hasFatalError_{false};
 };
 
 template <typename DSV> void ValueListIterator<DSV>::SetRepetitionCount() {
   for (repetitionsRemaining_ = 1; at_ != end_; ++at_) {
     auto repetitions{GetValue().repetitions};

 // Applies checks that validate each distinct elemental initialization
 // of the variables in a data-stmt-set, as well as those that apply
 // to the corresponding values being used to initialize each element.
 template <typename DSV = parser::DataStmtValue>
 class DataInitializationCompiler {
 public:
   DataInitializationCompiler(DataInitializations &inits,
       evaluate::ExpressionAnalyzer &a, const std::list<DSV> &list)
-      : inits_{inits}, exprAnalyzer_{a}, values_{list} {}
+      : inits_{inits}, exprAnalyzer_{a}, values_{a.context(), list} {}
   const DataInitializations &inits() const { return inits_; }
   bool HasSurplusValues() const { return !values_.IsAtEnd(); }
   bool Scan(const parser::DataStmtObject &);
   // Initializes all elements of whole variable or component
   bool Scan(const Symbol &);
 
 private:
   bool Scan(const parser::Variable &);
return std::visit(
           },
           [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
       },
       object.u);
 }
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::Scan(const parser::Variable &var) {
-  if (const auto *expr{GetExpr(var)}) {
+  if (const auto *expr{GetExpr(exprAnalyzer_.context(), var)}) {
     exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
     if (InitDesignator(*expr)) {
       return true;
     }
   }
   return false;
 }
 
bool DataInitializationCompiler<DSV>::Scan(
   }
   return false;
 }
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::Scan(const parser::DataImpliedDo &ido) {
   const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)};
   auto name{bounds.name.thing.thing};
-  const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)};
-  const auto *upperExpr{GetExpr(bounds.upper.thing.thing)};
-  const auto *stepExpr{
-      bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr};
+  const auto *lowerExpr{
+      GetExpr(exprAnalyzer_.context(), bounds.lower.thing.thing)};
+  const auto *upperExpr{
+      GetExpr(exprAnalyzer_.context(), bounds.upper.thing.thing)};
+  const auto *stepExpr{bounds.step
+          ? GetExpr(exprAnalyzer_.context(), bounds.step->thing.thing)
+          : nullptr};
   if (lowerExpr && upperExpr) {
     // Fold the bounds expressions (again) in case any of them depend
     // on outer implied DO loops.
     evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
     std::int64_t stepVal{1};
     if (stepExpr) {
       auto foldedStep{evaluate::Fold(context, SomeExpr{*stepExpr})};
       stepVal = ToInt64(foldedStep).value_or(1);

flang/lib/Semantics/resolve-directives.cpp

bool Pre(const parser::ModuleSubprogram &) {
     return true;
   }
 
   bool Pre(const parser::SpecificationPart &x) {
     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
     return true;
   }
 
+  bool Pre(const parser::StmtFunctionStmt &x) {
+    const auto &parsedExpr{std::get<parser::Scalar<parser::Expr>>(x.t)};
+    if (const auto *expr{GetExpr(context_, parsedExpr)}) {
+      for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
+        if (!IsStmtFunctionDummy(symbol)) {
+          stmtFunctionExprSymbols_.insert(symbol.GetUltimate());
+        }
+      }
+    }
+    return true;
+  }
+
   bool Pre(const parser::OpenMPBlockConstruct &);
   void Post(const parser::OpenMPBlockConstruct &);
 
   void Post(const parser::OmpBeginBlockDirective &) {
     GetContext().withinConstruct = true;
   }
 
   bool Pre(const parser::OpenMPSimpleStandaloneConstruct &);

flang/lib/Semantics/tools.cpp

bool ExprTypeKindIsDefault(
   auto dynamicType{expr.GetType()};
   return dynamicType &&
       dynamicType->category() != common::TypeCategory::Derived &&
       dynamicType->kind() == context.GetDefaultKind(dynamicType->category());
 }
 
 // If an analyzed expr or assignment is missing, dump the node and die.
 template <typename T>
-static void CheckMissingAnalysis(bool absent, const T &x) {
-  if (absent) {
+static void CheckMissingAnalysis(
+    bool crash, SemanticsContext *context, const T &x) {
+  if (crash && !(context && context->AnyFatalError())) {
     std::string buf;
     llvm::raw_string_ostream ss{buf};
     ss << "node has not been analyzed:\n";
     parser::DumpTree(ss, x);
     common::die(ss.str().c_str());
   }
 }
 
-template <typename T> static const SomeExpr *GetTypedExpr(const T &x) {
-  CheckMissingAnalysis(!x.typedExpr, x);
-  return common::GetPtrFromOptional(x.typedExpr->v);
-}
 const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
-  return GetTypedExpr(x);
+  CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
+  return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 }
 const SomeExpr *GetExprHelper::Get(const parser::Variable &x) {
-  return GetTypedExpr(x);
+  CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
+  return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 }
 const SomeExpr *GetExprHelper::Get(const parser::DataStmtConstant &x) {
-  return GetTypedExpr(x);
+  CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
+  return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 }
 const SomeExpr *GetExprHelper::Get(const parser::AllocateObject &x) {
-  return GetTypedExpr(x);
+  CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
+  return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 }
 const SomeExpr *GetExprHelper::Get(const parser::PointerObject &x) {
-  return GetTypedExpr(x);
+  CheckMissingAnalysis(crashIfNoExpr_ && !x.typedExpr, context_, x);
+  return x.typedExpr ? common::GetPtrFromOptional(x.typedExpr->v) : nullptr;
 }
 
 const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) {
-  CheckMissingAnalysis(!x.typedAssignment, x);
-  return common::GetPtrFromOptional(x.typedAssignment->v);
+  return x.typedAssignment ? common::GetPtrFromOptional(x.typedAssignment->v)
+                           : nullptr;
 }
 const evaluate::Assignment *GetAssignment(
     const parser::PointerAssignmentStmt &x) {
-  CheckMissingAnalysis(!x.typedAssignment, x);
-  return common::GetPtrFromOptional(x.typedAssignment->v);
+  return x.typedAssignment ? common::GetPtrFromOptional(x.typedAssignment->v)
+                           : nullptr;
 }
 
 const Symbol *FindInterface(const Symbol &symbol) {
   return std::visit(
       common::visitors{
           [](const ProcEntityDetails &details) {
             return details.interface().symbol();
           },
return std::visit(
             return actionStmt.source;
           },
           [](const auto &) { return parser::CharBlock{}; },
       },
       executableConstruct.u);
 }
 
 bool HasCoarray(const parser::Expr &expression) {
-  if (const auto *expr{GetExpr(expression)}) {
+  if (const auto *expr{GetExpr(nullptr, expression)}) {
     for (const Symbol &symbol : evaluate::CollectSymbols(*expr)) {
       if (evaluate::IsCoarray(symbol)) {
         return true;
       }
     }
   }
   return false;
 }