[flang] Allow compiler directives in macros

Modify the prescanner to allow compiler directives to appear in
macro expansions, and adjust the parser to accept a semicolon
as a directive terminator.

Differential Revision: https://reviews.llvm.org/D150780

flang/include/flang/Parser/char-block.h

@@ -64,6 +64,18 @@ class CharBlock {
     return ' '; // non no-blank character
   }
 
+  std::size_t CountLeadingBlanks() const {
+    std::size_t n{size()};
+    std::size_t j{0};
+    for (; j < n; ++j) {
+      char ch{(*this)[j]};
+      if (ch != ' ' && ch != '\t') {
+        break;
+      }
+    }
+    return j;
+  }
+
   bool IsBlank() const { return FirstNonBlank() == ' '; }
 
   std::string ToString() const {

flang/lib/Parser/Fortran-parsers.cpp

@@ -1217,7 +1217,6 @@ TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) ||
 // !DIR$ LOOP COUNT (n1[, n2]...)
 // !DIR$ name...
 constexpr auto beginDirective{skipStuffBeforeStatement >> "!"_ch};
-constexpr auto endDirective{space >> endOfLine};
 constexpr auto ignore_tkr{
     "DIR$ IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(
                              maybe(parenthesized(many(letter))), name))};
@@ -1231,7 +1230,7 @@ TYPE_PARSER(beginDirective >>
         construct<CompilerDirective>(
             "DIR$" >> many(construct<CompilerDirective::NameValue>(name,
                           maybe(("="_tok || ":"_tok) >> digitString64))))) /
-        endDirective)
+        endOfStmt)
 
 TYPE_PARSER(extension<LanguageFeature::CrayPointer>(
     "nonstandard usage: based POINTER"_port_en_US,

flang/lib/Parser/prescan.cpp

@@ -204,7 +204,7 @@ void Prescanner::Statement() {
       NormalizeCompilerDirectiveCommentMarker(*preprocessed);
       preprocessed->ToLowerCase();
       SourceFormChange(preprocessed->ToString());
-      preprocessed->ClipComment(true /* skip first ! */)
+      preprocessed->ClipComment(*this, true /* skip first ! */)
           .CheckBadFortranCharacters(messages_)
           .CheckBadParentheses(messages_)
           .Emit(cooked_);
@@ -220,7 +220,7 @@ void Prescanner::Statement() {
         }
       }
       preprocessed->ToLowerCase()
-          .ClipComment()
+          .ClipComment(*this)
           .CheckBadFortranCharacters(messages_)
           .CheckBadParentheses(messages_)
           .Emit(cooked_);
@@ -1140,7 +1140,8 @@ Prescanner::IsFixedFormCompilerDirectiveLine(const char *start) const {
     return std::nullopt;
   }
   *sp = '\0';
-  if (const char *ss{IsCompilerDirectiveSentinel(sentinel)}) {
+  if (const char *ss{IsCompilerDirectiveSentinel(
+          sentinel, static_cast<std::size_t>(sp - sentinel))}) {
     std::size_t payloadOffset = p - start;
     return {LineClassification{
         LineClassification::Kind::CompilerDirective, payloadOffset, ss}};
@@ -1168,7 +1169,7 @@ Prescanner::IsFreeFormCompilerDirectiveLine(const char *start) const {
       if (*p == '!') {
         break;
       }
-      if (const char *sp{IsCompilerDirectiveSentinel(sentinel)}) {
+      if (const char *sp{IsCompilerDirectiveSentinel(sentinel, j)}) {
         std::size_t offset = p - start;
         return {LineClassification{
             LineClassification::Kind::CompilerDirective, offset, sp}};
@@ -1192,17 +1193,16 @@ Prescanner &Prescanner::AddCompilerDirectiveSentinel(const std::string &dir) {
 }
 
 const char *Prescanner::IsCompilerDirectiveSentinel(
-    const char *sentinel) const {
+    const char *sentinel, std::size_t len) const {
   std::uint64_t packed{0};
-  std::size_t n{0};
-  for (; sentinel[n] != '\0'; ++n) {
-    packed = (packed << 8) | (sentinel[n] & 0xff);
+  for (std::size_t j{0}; j < len; ++j) {
+    packed = (packed << 8) | (sentinel[j] & 0xff);
   }
-  if (n == 0 || !compilerDirectiveBloomFilter_.test(packed % prime1) ||
+  if (len == 0 || !compilerDirectiveBloomFilter_.test(packed % prime1) ||
       !compilerDirectiveBloomFilter_.test(packed % prime2)) {
     return nullptr;
   }
-  const auto iter{compilerDirectiveSentinels_.find(std::string(sentinel, n))};
+  const auto iter{compilerDirectiveSentinels_.find(std::string(sentinel, len))};
   return iter == compilerDirectiveSentinels_.end() ? nullptr : iter->c_str();
 }
 

flang/lib/Parser/prescan.h

@@ -68,6 +68,7 @@ class Prescanner {
   bool IsNextLinePreprocessorDirective() const;
   TokenSequence TokenizePreprocessorDirective();
   Provenance GetCurrentProvenance() const { return GetProvenance(at_); }
+  const char *IsCompilerDirectiveSentinel(const char *, std::size_t) const;
 
   template <typename... A> Message &Say(A &&...a) {
     return messages_.Say(std::forward<A>(a)...);
@@ -182,7 +183,6 @@ class Prescanner {
       const char *) const;
   std::optional<LineClassification> IsFreeFormCompilerDirectiveLine(
       const char *) const;
-  const char *IsCompilerDirectiveSentinel(const char *) const;
   LineClassification ClassifyLine(const char *) const;
   void SourceFormChange(std::string &&);
 

flang/lib/Parser/token-sequence.cpp

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "token-sequence.h"
+#include "prescan.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/message.h"
 #include "llvm/Support/raw_ostream.h"
@@ -244,11 +245,31 @@ TokenSequence &TokenSequence::RemoveRedundantBlanks(std::size_t firstChar) {
   return *this;
 }
 
-TokenSequence &TokenSequence::ClipComment(bool skipFirst) {
+TokenSequence &TokenSequence::ClipComment(
+    const Prescanner &prescanner, bool skipFirst) {
   std::size_t tokens{SizeInTokens()};
   for (std::size_t j{0}; j < tokens; ++j) {
-    if (TokenAt(j).FirstNonBlank() == '!') {
-      if (skipFirst) {
+    CharBlock tok{TokenAt(j)};
+    if (std::size_t blanks{tok.CountLeadingBlanks()};
+        blanks < tok.size() && tok[blanks] == '!') {
+      // Retain active compiler directive sentinels (e.g. "!dir$")
+      for (std::size_t k{j + 1}; k < tokens && tok.size() < blanks + 5; ++k) {
+        if (tok.begin() + tok.size() == TokenAt(k).begin()) {
+          tok.ExtendToCover(TokenAt(k));
+        } else {
+          break;
+        }
+      }
+      bool isSentinel{false};
+      if (tok.size() == blanks + 5) {
+        char sentinel[4];
+        for (int k{0}; k < 4; ++k) {
+          sentinel[k] = ToLowerCaseLetter(tok[blanks + k + 1]);
+        }
+        isSentinel = prescanner.IsCompilerDirectiveSentinel(sentinel, 4);
+      }
+      if (isSentinel) {
+      } else if (skipFirst) {
         skipFirst = false;
       } else {
         TokenSequence result;
@@ -315,11 +336,12 @@ ProvenanceRange TokenSequence::GetProvenanceRange() const {
 const TokenSequence &TokenSequence::CheckBadFortranCharacters(
     Messages &messages) const {
   std::size_t tokens{SizeInTokens()};
+  bool isBangOk{true};
   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) {
+      if (ch == '!' && isBangOk) {
         // allow in !dir$
       } else if (ch < ' ' || ch >= '\x7f') {
         messages.Say(GetTokenProvenanceRange(j),
@@ -329,6 +351,11 @@ const TokenSequence &TokenSequence::CheckBadFortranCharacters(
             "bad character ('%c') in Fortran token"_err_en_US, ch);
       }
     }
+    if (ch == ';') {
+      isBangOk = true;
+    } else if (ch != ' ') {
+      isBangOk = false;
+    }
   }
   return *this;
 }

flang/lib/Parser/token-sequence.h

@@ -28,6 +28,7 @@ class raw_ostream;
 namespace Fortran::parser {
 
 class Messages;
+class Prescanner;
 
 // Buffers a contiguous sequence of characters that has been partitioned into
 // a sequence of preprocessing tokens with provenances.
@@ -115,7 +116,7 @@ class TokenSequence {
   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);
+  TokenSequence &ClipComment(const Prescanner &, bool skipFirst = false);
   const TokenSequence &CheckBadFortranCharacters(Messages &) const;
   const TokenSequence &CheckBadParentheses(Messages &) const;
   void Emit(CookedSource &) const;

flang/test/Parser/compiler-directives.f90

@@ -2,6 +2,12 @@
 
 ! Test that compiler directives can appear in various places.
 
+#define PROC(KIND) \
+  interface; integer(KIND) function foo(a); \
+    integer(KIND), intent(in) :: a; \
+    !dir$ ignore_tkr a; \
+  end; end interface
+
 !dir$ integer
 module m
   !dir$ integer
@@ -11,6 +17,7 @@ module m
   !dir$ integer
   !dir$ integer=64
   !dir$ integer = 64
+  PROC(4)
   !dir$ optimize:1
   !dir$ optimize : 1
   !dir$ loop count (10000)