[flang] Improve error handling for bad characters in source

[klausler]

Summary

When an illegal character appears in Fortran source (after
preprocessing), catch and report it in the prescanning phase
rather than leaving it for the parser to cope with.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Parser/characters.h

inline constexpr std::optional<char> BackslashEscapeChar(char ch) {
   case '\'':
   case '\\':
     return ch;
   default:
     return std::nullopt;
   }
 }
 
+// Does not include spaces or line ending characters.
+inline constexpr bool IsValidFortranTokenCharacter(char ch) {
+  switch (ch) {
+  case '"':
+  case '%':
+  case '\'':
+  case '(':
+  case ')':
+  case '*':
+  case '+':
+  case ',':
+  case '-':
+  case '.':
+  case '/':
+  case ':':
+  case ';':
+  case '<':
+  case '=':
+  case '>':
+  case '[':
+  case ']':
+    return true;
+  default:
+    return IsLegalIdentifierStart(ch) || IsDecimalDigit(ch);
+  }
+}
+
 struct EncodedCharacter {
   static constexpr int maxEncodingBytes{6};
   char buffer[maxEncodingBytes];
   int bytes{0};
 };
 
 template <Encoding ENCODING> EncodedCharacter EncodeCharacter(char32_t ucs);
 template <> EncodedCharacter EncodeCharacter<Encoding::LATIN_1>(char32_t);

flang/lib/Parser/prescan.cpp

case LineClassification::Kind::IncludeLine:
       FortranInclude(ppd + ppl.payloadOffset);
       break;
     case LineClassification::Kind::ConditionalCompilationDirective:
     case LineClassification::Kind::IncludeDirective:
     case LineClassification::Kind::DefinitionDirective:
     case LineClassification::Kind::PreprocessorDirective:
       Say(preprocessed->GetProvenanceRange(),
           "Preprocessed line resembles a preprocessor directive"_en_US);
-      preprocessed->ToLowerCase().Emit(cooked_);
+      preprocessed->ToLowerCase().CheckBadFortranCharacters(messages_).Emit(
+          cooked_);
       break;
     case LineClassification::Kind::CompilerDirective:
       if (preprocessed->HasRedundantBlanks()) {
         preprocessed->RemoveRedundantBlanks();
       }
       NormalizeCompilerDirectiveCommentMarker(*preprocessed);
       preprocessed->ToLowerCase();
       SourceFormChange(preprocessed->ToString());
-      preprocessed->ClipComment(true /* skip first ! */).Emit(cooked_);
+      preprocessed->ClipComment(true /* skip first ! */)
+          .CheckBadFortranCharacters(messages_)
+          .Emit(cooked_);
       break;
     case LineClassification::Kind::Source:
       if (inFixedForm_) {
         if (preprocessed->HasBlanks(/*after column*/ 6)) {
           preprocessed->RemoveBlanks(/*after column*/ 6);
         }
       } else {
         if (preprocessed->HasRedundantBlanks()) {
           preprocessed->RemoveRedundantBlanks();
         }
       }
-      preprocessed->ToLowerCase().ClipComment().Emit(cooked_);
+      preprocessed->ToLowerCase()
+          .ClipComment()
+          .CheckBadFortranCharacters(messages_)
+          .Emit(cooked_);
       break;
     }
   } else {
     tokens.ToLowerCase();
     if (line.kind == LineClassification::Kind::CompilerDirective) {
       SourceFormChange(tokens.ToString());
     }
-    tokens.Emit(cooked_);
+    tokens.CheckBadFortranCharacters(messages_).Emit(cooked_);
   }
   if (omitNewline_) {
     omitNewline_ = false;
   } else {
     cooked_.Put('\n', newlineProvenance);
   }
   directiveSentinel_ = nullptr;
 }

flang/lib/Parser/token-sequence.h

 #include <vector>
 
 namespace llvm {
 class raw_ostream;
 }
 
 namespace Fortran::parser {
 
+class Messages;
+
 // Buffers a contiguous sequence of characters that has been partitioned into
 // a sequence of preprocessing tokens with provenances.
 class TokenSequence {
 public:
   TokenSequence() {}
   TokenSequence(const TokenSequence &that) { Put(that); }
   TokenSequence(
       const TokenSequence &that, std::size_t at, std::size_t count = 1) {
public:
 
   char *GetMutableCharData() { return &char_[0]; }
   TokenSequence &ToLowerCase();
   bool HasBlanks(std::size_t firstChar = 0) const;
   bool HasRedundantBlanks(std::size_t firstChar = 0) const;
   TokenSequence &RemoveBlanks(std::size_t firstChar = 0);
   TokenSequence &RemoveRedundantBlanks(std::size_t firstChar = 0);
   TokenSequence &ClipComment(bool skipFirst = false);
+  const TokenSequence &CheckBadFortranCharacters(Messages &) const;
   void Emit(CookedSource &) const;
   void Dump(llvm::raw_ostream &) const;
 
 private:
   std::size_t TokenBytes(std::size_t token) const {
     return (token + 1 >= start_.size() ? char_.size() : start_[token + 1]) -
         start_[token];
   }
 
   std::vector<std::size_t> start_;
   std::size_t nextStart_{0};
   std::vector<char> char_;
   OffsetToProvenanceMappings provenances_;
 };
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_TOKEN_SEQUENCE_H_

flang/lib/Parser/token-sequence.cpp

 //===-- lib/Parser/token-sequence.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 "token-sequence.h"
 #include "flang/Parser/characters.h"
+#include "flang/Parser/message.h"
 #include "llvm/Support/raw_ostream.h"
 
 namespace Fortran::parser {
 
 TokenSequence &TokenSequence::operator=(TokenSequence &&that) {
   clear();
   swap(that);
   return *this;
while (--tokens > 0 &&
       range.AnnexIfPredecessor(provenances_.Map(start_[++token]))) {
   }
   return range;
 }
 
 ProvenanceRange TokenSequence::GetProvenanceRange() const {
   return GetIntervalProvenanceRange(0, start_.size());
 }
+
+const TokenSequence &TokenSequence::CheckBadFortranCharacters(
+    Messages &messages) const {
+  std::size_t tokens{SizeInTokens()};
+  for (std::size_t j{0}; j < tokens; ++j) {
+    CharBlock token{TokenAt(j)};
+    char ch{token.FirstNonBlank()};
+    if (ch != ' ' && !IsValidFortranTokenCharacter(ch)) {
+      if (ch == '!' && j == 0) {
+        // allow in !dir$
+      } else if (ch < ' ' || ch >= '\x7f') {
+        messages.Say(GetTokenProvenanceRange(j),
+            "bad character (0x%02x) in Fortran token"_err_en_US, ch & 0xff);
+      } else {
+        messages.Say(GetTokenProvenanceRange(j),
+            "bad character ('%c') in Fortran token"_err_en_US, ch);
+      }
+    }
+  }
+  return *this;
+}
 } // namespace Fortran::parser

flang/test/Preprocessing/pp130.F90

-! RUN: %f18 -E %s 2>&1 | FileCheck %s
-! CHECK: j = j + &
+! RUN: (%f18 -E %s 2>&1 || true) | FileCheck %s
+! CHECK: error: bad character ('&') in Fortran token
 ! #define KWM &, use for continuation w/o pasting (ifort and nag seem to continue #define)
 #define KWM &
 
       integer :: j
       j = 666
       j = j + KWM
 111
       if (j .eq. 777) then
         print *, 'pp130.F90 yes'
       else
         print *, 'pp130.F90 no', j
       end if
       end