[flang] Allow compiler directives in macros

[klausler]

Summary

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

[DanielCChen]

LGTM. Thanks.

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

char FirstNonBlank() const {
     for (char ch : *this) {
       if (ch != ' ' && ch != '\t') {
         return ch;
       }
     }
     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 {
     return std::string{interval_.start(), interval_.size()};
   }
 
   // Convert to string, stopping early at any embedded '\0'.
   std::string NULTerminatedToString() const {

flang/lib/Parser/Fortran-parsers.cpp

 TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) ||
     construct<StatOrErrmsg>("ERRMSG =" >> msgVariable))
 
 // Directives, extensions, and deprecated statements
 // !DIR$ IGNORE_TKR [ [(tkrdmac...)] name ]...
 // !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))};
 constexpr auto loopCount{
     "DIR$ LOOP COUNT" >> construct<CompilerDirective::LoopCount>(
                              parenthesized(nonemptyList(digitString64)))};
 
 TYPE_PARSER(beginDirective >>
     sourced(construct<CompilerDirective>(ignore_tkr) ||
         construct<CompilerDirective>(loopCount) ||
         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,
     construct<BasedPointerStmt>(
         "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,
                          construct<BasedPointer>("(" >> objectName / ",",
                              objectName, maybe(Parser<ArraySpec>{}) / ")")))))
 

flang/lib/Parser/prescan.h

public:
   void Statement();
   void NextLine();
 
   // Callbacks for use by Preprocessor.
   bool IsAtEnd() const { return nextLine_ >= limit_; }
   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)...);
   }
 
 private:
   struct LineClassification {
     enum class Kind {
private:
   bool IsImplicitContinuation() const;
   bool FixedFormContinuation(bool mightNeedSpace);
   bool FreeFormContinuation();
   bool Continuation(bool mightNeedFixedFormSpace);
   std::optional<LineClassification> IsFixedFormCompilerDirectiveLine(
       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 &&);
 
   Messages &messages_;
   CookedSource &cooked_;
   Preprocessor &preprocessor_;
   AllSources &allSources_;
   common::LanguageFeatureControl features_;

flang/lib/Parser/prescan.cpp

case LineClassification::Kind::PreprocessorDirective:
       break;
     case LineClassification::Kind::CompilerDirective:
       if (preprocessed->HasRedundantBlanks()) {
         preprocessed->RemoveRedundantBlanks();
       }
       NormalizeCompilerDirectiveCommentMarker(*preprocessed);
       preprocessed->ToLowerCase();
       SourceFormChange(preprocessed->ToString());
-      preprocessed->ClipComment(true /* skip first ! */)
+      preprocessed->ClipComment(*this, true /* skip first ! */)
           .CheckBadFortranCharacters(messages_)
           .CheckBadParentheses(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()
+          .ClipComment(*this)
           .CheckBadFortranCharacters(messages_)
           .CheckBadParentheses(messages_)
           .Emit(cooked_);
       break;
     }
   } else {
     tokens.ToLowerCase();
     if (line.kind == LineClassification::Kind::CompilerDirective) {
if (*p == ' ' || *p == '\t' || *p == '0') {
       // This is a Continuation line, not an initial directive line.
       return std::nullopt;
     }
   }
   if (sp == sentinel) {
     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}};
   }
   return std::nullopt;
 }
 
 std::optional<Prescanner::LineClassification>
if (*p == ' ' || *p == '\t' || *p == '&') {
       if (j == 0) {
         break;
       }
       sentinel[j] = '\0';
       p = SkipWhiteSpace(p + 1);
       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}};
       }
       break;
     }
     sentinel[j] = ToLowerCaseLetter(*p);
   }
   return std::nullopt;
 }
 
 Prescanner &Prescanner::AddCompilerDirectiveSentinel(const std::string &dir) {
   std::uint64_t packed{0};
   for (char ch : dir) {
     packed = (packed << 8) | (ToLowerCaseLetter(ch) & 0xff);
   }
   compilerDirectiveBloomFilter_.set(packed % prime1);
   compilerDirectiveBloomFilter_.set(packed % prime2);
   compilerDirectiveSentinels_.insert(dir);
   return *this;
 }
 
 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();
 }
 
 constexpr bool IsDirective(const char *match, const char *dir) {
   for (; *match; ++match) {
     if (*match != ToLowerCaseLetter(*dir++)) {
       return false;
     }

flang/lib/Parser/token-sequence.h

 
 namespace llvm {
 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.
 class TokenSequence {
 public:
   TokenSequence() {}
   TokenSequence(const TokenSequence &that) { Put(that); }
   TokenSequence(
public:
   ProvenanceRange GetProvenanceRange() const;
 
   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);
+  TokenSequence &ClipComment(const Prescanner &, 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;
 
 private:
   std::size_t TokenBytes(std::size_t token) const {
     return (token + 1 >= start_.size() ? char_.size() : start_[token + 1]) -

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 "prescan.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();
if (!isBlank || !lastWasBlank || start_[j] < firstChar) {
       result.Put(*this, j);
     }
     lastWasBlank = isBlank;
   }
   swap(result);
   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;
         if (j > 0) {
           result.Put(*this, 0, j - 1);
         }
         swap(result);
         return *this;

 
 ProvenanceRange TokenSequence::GetProvenanceRange() const {
   return GetIntervalProvenanceRange(0, start_.size());
 }
 
 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),
             "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);
       }
     }
+    if (ch == ';') {
+      isBangOk = true;
+    } else if (ch != ' ') {
+      isBangOk = false;
+    }
   }
   return *this;
 }
 
 const TokenSequence &TokenSequence::CheckBadParentheses(
     Messages &messages) const {
   // First, a quick pass with no allocation for the common case
   int nesting{0};

flang/test/Parser/compiler-directives.f90

 ! RUN: %flang_fc1 -fdebug-unparse %s 2>&1
 
 ! 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
   use iso_fortran_env
   !dir$ integer
   implicit integer(a-z)
   !dir$ integer
   !dir$ integer=64
   !dir$ integer = 64
+  PROC(4)
   !dir$ optimize:1
   !dir$ optimize : 1
   !dir$ loop count (10000)
   !dir$ loop count (1, 500, 5000, 10000)
 end