[flang][preprocessor] Handle compiler directives with continuations a… (#70128)

…fter macro expansion

When compiler directives (!$omp) and/or their continuations (!$omp &)
are produced by macro expansion, handle those continuations. Also allow
a continuation marker (&) to appear in a macro actual argument.

Author: klausler

flang/docs/Preprocessing.md

@@ -228,5 +228,5 @@ E . . E E .   pp125.F90  #DEFINE works in free form
 . . E . E E   pp127.F90  FLM call with closing ')' on next line (not a continuation)
 E . E . E E   pp128.F90  FLM call with '(' on next line (not a continuation)
 . . N . . N   pp129.F90  #define KWM !, then KWM works as comment line initiator
-E . E . . E   pp130.F90  #define KWM &, use for continuation w/o pasting (ifort and nag seem to continue #define)
+. . E . . E   pp130.F90  #define KWM &, use for continuation w/o pasting (ifort and nag seem to continue #define)
 ```

flang/lib/Parser/prescan.cpp

@@ -213,6 +213,9 @@ void Prescanner::Statement() {
       if (preprocessed->HasRedundantBlanks()) {
         preprocessed->RemoveRedundantBlanks();
       }
+      while (CompilerDirectiveContinuation(*preprocessed, ppl.sentinel)) {
+        newlineProvenance = GetCurrentProvenance();
+      }
       NormalizeCompilerDirectiveCommentMarker(*preprocessed);
       preprocessed->ToLowerCase();
       SourceFormChange(preprocessed->ToString());
@@ -227,6 +230,9 @@ void Prescanner::Statement() {
           preprocessed->RemoveBlanks(/*after column*/ 6);
         }
       } else {
+        while (SourceLineContinuation(*preprocessed)) {
+          newlineProvenance = GetCurrentProvenance();
+        }
         if (preprocessed->HasRedundantBlanks()) {
           preprocessed->RemoveRedundantBlanks();
         }
@@ -239,12 +245,17 @@ void Prescanner::Statement() {
       break;
     }
   } else {
-    tokens.ToLowerCase();
     if (line.kind == LineClassification::Kind::CompilerDirective) {
+      while (CompilerDirectiveContinuation(tokens, line.sentinel)) {
+        newlineProvenance = GetCurrentProvenance();
+      }
+      tokens.ToLowerCase();
       SourceFormChange(tokens.ToString());
-    }
-    if (inFixedForm_ && line.kind == LineClassification::Kind::Source) {
-      EnforceStupidEndStatementRules(tokens);
+    } else { // Kind::Source
+      tokens.ToLowerCase();
+      if (inFixedForm_) {
+        EnforceStupidEndStatementRules(tokens);
+      }
     }
     tokens.CheckBadFortranCharacters(messages_)
         .CheckBadParentheses(messages_)
@@ -1132,8 +1143,10 @@ bool Prescanner::FreeFormContinuation() {
   if (*p != '\n') {
     if (inCharLiteral_) {
       return false;
-    } else if (*p != '!' &&
-        features_.ShouldWarn(LanguageFeature::CruftAfterAmpersand)) {
+    } else if (*p == '!') { // & ! comment - ok
+    } else if (ampersand && isPossibleMacroCall_ && (*p == ',' || *p == ')')) {
+      return false; // allow & at end of a macro argument
+    } else if (features_.ShouldWarn(LanguageFeature::CruftAfterAmpersand)) {
       Say(GetProvenance(p), "missing ! before comment after &"_warn_en_US);
     }
   }
@@ -1318,4 +1331,107 @@ void Prescanner::SourceFormChange(std::string &&dir) {
     inFixedForm_ = true;
   }
 }
+
+// Acquire and append compiler directive continuation lines to
+// the tokens that constitute a compiler directive, even when those
+// directive continuation lines are the result of macro expansion.
+// (Not used when neither the original compiler directive line nor
+// the directive continuation line result from preprocessing; regular
+// line continuation during tokenization handles that normal case.)
+bool Prescanner::CompilerDirectiveContinuation(
+    TokenSequence &tokens, const char *origSentinel) {
+  if (inFixedForm_ || tokens.empty() ||
+      tokens.TokenAt(tokens.SizeInTokens() - 1) != "&") {
+    return false;
+  }
+  LineClassification followingLine{ClassifyLine(nextLine_)};
+  if (followingLine.kind == LineClassification::Kind::Comment) {
+    nextLine_ += followingLine.payloadOffset; // advance to '!' or newline
+    NextLine();
+    return true;
+  }
+  CHECK(origSentinel != nullptr);
+  directiveSentinel_ = origSentinel; // so IsDirective() is true
+  const char *nextContinuation{
+      followingLine.kind == LineClassification::Kind::CompilerDirective
+          ? FreeFormContinuationLine(true)
+          : nullptr};
+  if (!nextContinuation &&
+      followingLine.kind != LineClassification::Kind::Source) {
+    return false;
+  }
+  auto origNextLine{nextLine_};
+  BeginSourceLine(nextLine_);
+  NextLine();
+  TokenSequence followingTokens;
+  if (nextContinuation) {
+    // What follows is !DIR$ & xxx; skip over the & so that it
+    // doesn't cause a spurious continuation.
+    at_ = nextContinuation;
+  } else {
+    // What follows looks like a source line before macro expansion,
+    // but might become a directive continuation afterwards.
+    SkipSpaces();
+  }
+  while (NextToken(followingTokens)) {
+  }
+  if (auto followingPrepro{
+          preprocessor_.MacroReplacement(followingTokens, *this)}) {
+    followingTokens = std::move(*followingPrepro);
+  }
+  followingTokens.RemoveRedundantBlanks();
+  std::size_t startAt{0};
+  std::size_t keep{followingTokens.SizeInTokens()};
+  bool ok{false};
+  if (nextContinuation) {
+    ok = true;
+  } else {
+    if (keep >= 3 && followingTokens.TokenAt(0) == "!" &&
+        followingTokens.TokenAt(2) == "&") {
+      CharBlock sentinel{followingTokens.TokenAt(1)};
+      if (!sentinel.empty() &&
+          std::memcmp(sentinel.begin(), origSentinel, sentinel.size()) == 0) {
+        startAt = 3;
+        keep -= 3;
+        ok = true;
+      }
+    }
+  }
+  if (ok) {
+    tokens.pop_back(); // delete original '&'
+    tokens.Put(followingTokens, startAt, keep);
+  } else {
+    nextLine_ = origNextLine;
+  }
+  return ok;
+}
+
+// Similar, but for source line continuation after macro replacement.
+bool Prescanner::SourceLineContinuation(TokenSequence &tokens) {
+  if (!inFixedForm_ && !tokens.empty() &&
+      tokens.TokenAt(tokens.SizeInTokens() - 1) == "&") {
+    LineClassification followingLine{ClassifyLine(nextLine_)};
+    if (followingLine.kind == LineClassification::Kind::Comment) {
+      nextLine_ += followingLine.payloadOffset; // advance to '!' or newline
+      NextLine();
+      return true;
+    } else if (const char *nextContinuation{FreeFormContinuationLine(true)}) {
+      BeginSourceLine(nextLine_);
+      NextLine();
+      TokenSequence followingTokens;
+      at_ = nextContinuation;
+      while (NextToken(followingTokens)) {
+      }
+      if (auto followingPrepro{
+              preprocessor_.MacroReplacement(followingTokens, *this)}) {
+        followingTokens = std::move(*followingPrepro);
+      }
+      followingTokens.RemoveRedundantBlanks();
+      tokens.pop_back(); // delete original '&'
+      tokens.Put(followingTokens);
+      return true;
+    }
+  }
+  return false;
+}
 } // namespace Fortran::parser

flang/lib/Parser/prescan.h

@@ -186,6 +186,8 @@ class Prescanner {
       const char *) const;
   LineClassification ClassifyLine(const char *) const;
   void SourceFormChange(std::string &&);
+  bool CompilerDirectiveContinuation(TokenSequence &, const char *sentinel);
+  bool SourceLineContinuation(TokenSequence &);
 
   Messages &messages_;
   CookedSource &cooked_;

flang/test/Preprocessing/directive-contin-with-pp.F90

@@ -0,0 +1,41 @@
+! RUN: %flang -E %s 2>&1 | FileCheck %s
+
+#define DIR_START !dir$
+#define DIR_CONT !dir$&
+#define FIRST(x) DIR_START x
+#define NEXT(x) DIR_CONT x
+#define AMPER &
+
+subroutine s(x1, x2, x3, x4, x5, x6, x7)
+
+!dir$ ignore_tkr x1
+
+!dir$ ignore_tkr &
+!dir$& x2
+
+DIR_START ignore_tkr x3
+
+!dir$ ignore_tkr AMPER
+DIR_CONT x4
+
+FIRST(ignore_tkr &)
+!dir$& x5
+
+FIRST(ignore_tkr &)
+NEXT(x6)
+
+FIRST(ignore_tkr &)
+NEXT(x7 &)
+NEXT(x8)
+
+end
+
+!CHECK: subroutine s(x1, x2, x3, x4, x5, x6, x7)
+!CHECK: !dir$ ignore_tkr x1
+!CHECK: !dir$ ignore_tkr x2
+!CHECK: !dir$ ignore_tkr x3
+!CHECK: !dir$ ignore_tkr  x4
+!CHECK: !dir$ ignore_tkr  x5
+!CHECK: !dir$ ignore_tkr  x6
+!CHECK: !dir$ ignore_tkr  x7  x8
+!CHECK: end

flang/test/Preprocessing/pp130.F90

@@ -1,8 +1,7 @@
-! RUN: not %flang -E %s 2>&1 | FileCheck %s
-! CHECK: error: bad character ('&') in Fortran token
+! RUN: %flang -E %s 2>&1 | FileCheck %s
+! CHECK: j = j +  111
 ! #define KWM &, use for continuation w/o pasting (ifort and nag seem to continue #define)
 #define KWM &
-
       integer :: j
       j = 666
       j = j + KWM