[flang] Fix crash on erroneous expressions

[PeteSteinfeld]

Summary

If you create an expression with parse errors, the parser::Expr.typedExpr
will be empty, which causes a compiler crash. The crash is caused by the
check in check-do-forall.cpp that scans all expresssions to see if DO
variables are being modified.

It turned out that the problem was that I was fetching subexpressions of type
parser::Expr, which are not guaranteed to have a non-null typedExpr. I
fixed this by only grabbing the top-level expression from which to gather
arguments as part of the DO loop analysis. This, in turn, exposed a problem
where I wasn't collecting all of the actual arguments in an expression.
Specifically, if an actual argument was a function call, I wasn't recursing
through the arguments of the called function. I fixed this by recursing
through the argument in the member function in
CollectActualArgumentsHelper.

[tskeith]

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

1052

GetExpr is supposed to return nullptr if the typedExpr is not present. If it's crashing the bug is inside GetExpr. Otherwise every call would have to be guarded with a check like this.

[PeteSteinfeld]

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

1052

In the code before I made my change, GetExpr(parser::Expr) was explicitly checking for an empty typedExpr by calling CheckMissingAnalysis() and calling common::die() if typedExpr was empty. But the code in check-do-forall.cpp is a little unusual since it's walking all expressions in a program looking for invalid uses of DO variables. That's why I put the check here. I guessed that all other calls to GetExpr() were done in situations where we were sure that typedExpr was not empty.

Note also that when GetExpr is called on a parser::Variable it also calls common::die() when typedExpr is missing. But I'm not sure how to construct a test case that would trigger this.

Should I just get rid of the call to CheckMissingAnalysis() when calling GetExpr(parser::Expr)? What about for the parser::Variable case?

[tskeith]

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

1052

There are two different kinds of "missing" that can happen in a typedExpr:

• if the unique_ptr is null it means we haven't tried to analyze it yet
• if the optional in GenericExprWrapper is absent it means we analyzed it and reported an error

The error in CheckMissingAnalysis is for the first case. It means expression analysis didn't look at that expression, but it should have by that point. So probably the bug is there.

[PeteSteinfeld]

It turned out that the problem was that I was fetching subexpressions of type
parser::Expr, which are not guaranteed to have a non-null typedExpr. I
fixed this by only grabbing the top-level expression from which to gather
arguments as part of the DO loop analysis. This, in turn, exposed a problem
where I wasn't collecting all of the actual arguments in an expression. This
was caused by the fact that I wasn't recursing through the rest of the
expression after finding an argument. I fixed this by recursing through the
argument in the member function in CollectActualArgumentsHelper.

[tskeith]

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

1048

This should be a member of DoForallChecker. It isn't meaningful outside of that class.

[PeteSteinfeld]

At Tim's suggestion, I moved exprDepth from being a static variable to a data
member.

[PeteSteinfeld]

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

1048

Thanks, Tim. I've made that change.

[tskeith]

Looks good. Be sure to update the description to match the change before committing.

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

public:
   void Enter(const parser::DoConstruct &);
   void Leave(const parser::DoConstruct &);
   void Enter(const parser::ForallConstruct &);
   void Leave(const parser::ForallConstruct &);
   void Enter(const parser::ForallStmt &);
   void Leave(const parser::ForallStmt &);
   void Leave(const parser::ForallAssignmentStmt &s);
   void Enter(const parser::ExitStmt &);
+  void Enter(const parser::Expr &);
   void Leave(const parser::Expr &);
   void Leave(const parser::InquireSpec &);
   void Leave(const parser::IoControlSpec &);
   void Leave(const parser::OutputImpliedDo &);
   void Leave(const parser::StatVariable &);
 
 private:
   SemanticsContext &context_;
+  int exprDepth_{0};
 
   void SayBadLeave(
       StmtType, const char *enclosingStmt, const ConstructNode &) const;
   void CheckDoConcurrentExit(StmtType, const ConstructNode &) const;
   void CheckForBadLeave(StmtType, const ConstructNode &) const;
   void CheckNesting(StmtType, const parser::Name *) const;
 };
 } // namespace Fortran::semantics
 #endif

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

 
 struct CollectActualArgumentsHelper
     : public evaluate::SetTraverse<CollectActualArgumentsHelper,
           ActualArgumentSet> {
   using Base = SetTraverse<CollectActualArgumentsHelper, ActualArgumentSet>;
   CollectActualArgumentsHelper() : Base{*this} {}
   using Base::operator();
   ActualArgumentSet operator()(const evaluate::ActualArgument &arg) const {
-    return ActualArgumentSet{arg};
+    return Combine(ActualArgumentSet{arg},
+        CollectActualArgumentsHelper{}(arg.UnwrapExpr()));
   }
 };
 
 template <typename A> ActualArgumentSet CollectActualArguments(const A &x) {
   return CollectActualArgumentsHelper{}(x);
 }
 
 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)}) {
       ActualArgumentSet argSet{CollectActualArguments(*expr)};
       for (const evaluate::ActualArgumentRef &argRef : argSet) {
         CheckIfArgIsDoVar(*argRef, parsedExpr.source, context_);
       }
     }
   }
+}
 
 void DoForallChecker::Leave(const parser::InquireSpec &inquireSpec) {
   const auto *intVar{std::get_if<parser::InquireSpec::IntVar>(&inquireSpec.u)};
   if (intVar) {
     const auto &scalar{std::get<parser::ScalarIntVariable>(intVar->t)};
     context_.CheckIndexVarRedefine(scalar.thing.thing);
   }
 }

flang/test/Semantics/resolve91.f90

 end module m4
 
 module m5
   !ERROR: Actual argument for 'string=' has bad type 'REAL(4)'
   character(len=len(a)) :: b
   !ERROR: The type of 'a' has already been implicitly declared
   character(len=len(b)) :: a
 end module m5
+
+module m6
+  integer, dimension(3) :: iarray
+  !ERROR: Derived type 'ubound' not found
+  character(len=ubound(iarray)(1)) :: first
+end module m6
+
+module m7
+  integer, dimension(2) :: iarray
+  !ERROR: Derived type 'ubound' not found
+  integer :: ivar = ubound(iarray)(1)
+end module m7