[flang] Catch mismatched parentheses in prescanner

[klausler]

Summary

Source lines with mismatched parentheses are hard cases for error
recovery in parsing, and the best error message (viz.,
"here's an unmatched parenthesis") can be emitted from the
prescanner.

[PeteSteinfeld]

LGTM

Looks great! Thanks for doing this.

flang/lib/Parser/prescan.cpp

     preprocessed->CloseToken();
     const char *ppd{preprocessed->ToCharBlock().begin()};
     LineClassification ppl{ClassifyLine(ppd)};
-    preprocessed->RemoveLastToken(); // remove the newline
+    preprocessed->pop_back(); // remove the newline
     switch (ppl.kind) {
     case LineClassification::Kind::Comment:
       break;

     case LineClassification::Kind::PreprocessorDirective:
       Say(preprocessed->GetProvenanceRange(),
           "Preprocessed line resembles a preprocessor directive"_en_US);
-      preprocessed->ToLowerCase().CheckBadFortranCharacters(messages_).Emit(
-          cooked_);
+      preprocessed->ToLowerCase()
+          .CheckBadFortranCharacters(messages_)
+          .CheckBadParentheses(messages_)
+          .Emit(cooked_);
       break;
     case LineClassification::Kind::CompilerDirective:
       if (preprocessed->HasRedundantBlanks()) {

       SourceFormChange(preprocessed->ToString());
       preprocessed->ClipComment(true /* skip first ! */)
           .CheckBadFortranCharacters(messages_)
+          .CheckBadParentheses(messages_)
           .Emit(cooked_);
       break;
     case LineClassification::Kind::Source:

       preprocessed->ToLowerCase()
           .ClipComment()
           .CheckBadFortranCharacters(messages_)
+          .CheckBadParentheses(messages_)
           .Emit(cooked_);
       break;
     }

     if (inFixedForm_ && line.kind == LineClassification::Kind::Source) {
       EnforceStupidEndStatementRules(tokens);
     }
-    tokens.CheckBadFortranCharacters(messages_).Emit(cooked_);
+    tokens.CheckBadFortranCharacters(messages_)
+        .CheckBadParentheses(messages_)
+        .Emit(cooked_);
   }
   if (omitNewline_) {
     omitNewline_ = false;

 void Prescanner::LabelField(TokenSequence &token) {
   const char *bad{nullptr};
   int outCol{1};
+  const char *start{at_};
   for (; *at_ != '\n' && column_ <= 6; ++at_) {
     if (*at_ == '\t') {
       ++at_;

     }
     ++column_;
   }
+  if (bad && !preprocessor_.IsNameDefined(token.CurrentOpenToken())) {
+    Say(GetProvenance(bad),
+        "Character in fixed-form label field must be a digit"_en_US);
+    token.clear();
+    at_ = start;
+    return;
+  }
   if (outCol == 1) { // empty label field
     // Emit a space so that, if the line is rescanned after preprocessing,
     // a leading 'C' or 'D' won't be left-justified and then accidentally
     // misinterpreted as a comment card.
     EmitChar(token, ' ');
     ++outCol;
-  } else {
-    if (bad && !preprocessor_.IsNameDefined(token.CurrentOpenToken())) {
-      Say(GetProvenance(bad),
-          "Character in fixed-form label field must be a digit"_en_US);
-    }
   }
   token.CloseToken();
   SkipToNextSignificantCharacter();

flang/lib/Parser/token-sequence.h

     start_.pop_back();
   }
 
-  void RemoveLastToken();
-
   void Put(const TokenSequence &);
   void Put(const TokenSequence &, ProvenanceRange);
   void Put(const TokenSequence &, std::size_t at, std::size_t tokens = 1);

   TokenSequence &RemoveRedundantBlanks(std::size_t firstChar = 0);
   TokenSequence &ClipComment(bool skipFirst = false);
   const TokenSequence &CheckBadFortranCharacters(Messages &) const;
+  const TokenSequence &CheckBadParentheses(Messages &) const;
   void Emit(CookedSource &) const;
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
 

flang/lib/Parser/token-sequence.cpp

 }
 
 void TokenSequence::pop_back() {
+  CHECK(!start_.empty());
+  CHECK(nextStart_ > start_.back());
   std::size_t bytes{nextStart_ - start_.back()};
   nextStart_ = start_.back();
   start_.pop_back();

   return false;
 }
 
-void TokenSequence::RemoveLastToken() {
-  CHECK(!start_.empty());
-  CHECK(nextStart_ > start_.back());
-  std::size_t bytes{nextStart_ - start_.back()};
-  nextStart_ = start_.back();
-  start_.pop_back();
-  char_.erase(char_.begin() + nextStart_, char_.end());
-  provenances_.RemoveLastBytes(bytes);
-}
-
 void TokenSequence::Put(const TokenSequence &that) {
   if (nextStart_ < char_.size()) {
     start_.push_back(nextStart_);

   }
   return *this;
 }
+
+const TokenSequence &TokenSequence::CheckBadParentheses(
+    Messages &messages) const {
+  // First, a quick pass with no allocation for the common case
+  int nesting{0};
+  std::size_t tokens{SizeInTokens()};
+  for (std::size_t j{0}; j < tokens; ++j) {
+    CharBlock token{TokenAt(j)};
+    char ch{token.FirstNonBlank()};
+    if (ch == '(') {
+      ++nesting;
+    } else if (ch == ')') {
+      --nesting;
+    }
+  }
+  if (nesting != 0) {
+    // There's an error; diagnose it
+    std::vector<std::size_t> stack;
+    for (std::size_t j{0}; j < tokens; ++j) {
+      CharBlock token{TokenAt(j)};
+      char ch{token.FirstNonBlank()};
+      if (ch == '(') {
+        stack.push_back(j);
+      } else if (ch == ')') {
+        if (stack.empty()) {
+          messages.Say(GetTokenProvenanceRange(j), "Unmatched ')'"_err_en_US);
+          return *this;
+        }
+        stack.pop_back();
+      }
+    }
+    CHECK(!stack.empty());
+    messages.Say(
+        GetTokenProvenanceRange(stack.back()), "Unmatched '('"_err_en_US);
+  }
+  return *this;
+}
 } // namespace Fortran::parser

flang/test/Parser/unmatched-parens.f90

+! RUN: not %flang_fc1 -E %s 2>&1 | FileCheck %s
+do i = 1,10
+  ! CHECK: Unmatched '('
+  if (i != 0) then
+    exit
+  endif
+enddo
+end