[flang] Disable Fortran free form line continuation in non-source lin… (#94663)

…e produced by keyword macro replacement

When later initial keyword macro replacement will yield a line that is
not Fortran source, don't interpret "&" as a Fortran source line
continuation marker during tokenization of the line.

Fixes #82579.

Author: klausler

flang/include/flang/Parser/token-sequence.h

@@ -124,7 +124,7 @@ class TokenSequence {
   TokenSequence &RemoveRedundantBlanks(std::size_t firstChar = 0);
   TokenSequence &ClipComment(const Prescanner &, bool skipFirst = false);
   const TokenSequence &CheckBadFortranCharacters(
-      Messages &, const Prescanner &) const;
+      Messages &, const Prescanner &, bool allowAmpersand) const;
   const TokenSequence &CheckBadParentheses(Messages &) const;
   void Emit(CookedSource &) const;
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;

flang/lib/Parser/prescan.cpp

@@ -180,6 +180,28 @@ void Prescanner::Statement() {
       }
     } else {
       SkipSpaces();
+      // Check for a leading identifier that might be a keyword macro
+      // that will expand to anything indicating a non-source line, like
+      // a comment marker or directive sentinel.  If so, disable line
+      // continuation, so that NextToken() won't consume anything from
+      // following lines.
+      if (IsLegalIdentifierStart(*at_)) {
+        CHECK(NextToken(tokens));
+        CHECK(tokens.SizeInTokens() == 1);
+        CharBlock id{tokens.TokenAt(0)};
+        if (preprocessor_.IsNameDefined(id) &&
+            !preprocessor_.IsFunctionLikeDefinition(id)) {
+          if (auto replaced{preprocessor_.MacroReplacement(tokens, *this)}) {
+            auto newLineClass{ClassifyLine(*replaced, GetCurrentProvenance())};
+            disableSourceContinuation_ =
+                newLineClass.kind != LineClassification::Kind::Source;
+            if (newLineClass.kind ==
+                LineClassification::Kind::CompilerDirective) {
+              directiveSentinel_ = newLineClass.sentinel;
+            }
+          }
+        }
+      }
     }
     break;
   }
@@ -197,17 +219,13 @@ void Prescanner::Statement() {
   Provenance newlineProvenance{GetCurrentProvenance()};
   if (std::optional<TokenSequence> preprocessed{
           preprocessor_.MacroReplacement(tokens, *this)}) {
-    // Reprocess the preprocessed line.  Append a newline temporarily.
-    preprocessed->PutNextTokenChar('\n', newlineProvenance);
-    preprocessed->CloseToken();
-    const char *ppd{preprocessed->ToCharBlock().begin()};
-    LineClassification ppl{ClassifyLine(ppd)};
-    preprocessed->pop_back(); // remove the newline
+    // Reprocess the preprocessed line.
+    LineClassification ppl{ClassifyLine(*preprocessed, newlineProvenance)};
     switch (ppl.kind) {
     case LineClassification::Kind::Comment:
       break;
     case LineClassification::Kind::IncludeLine:
-      FortranInclude(ppd + ppl.payloadOffset);
+      FortranInclude(preprocessed->TokenAt(0).begin() + ppl.payloadOffset);
       break;
     case LineClassification::Kind::ConditionalCompilationDirective:
     case LineClassification::Kind::IncludeDirective:
@@ -270,7 +288,8 @@ void Prescanner::Statement() {
 
 void Prescanner::CheckAndEmitLine(
     TokenSequence &tokens, Provenance newlineProvenance) {
-  tokens.CheckBadFortranCharacters(messages_, *this);
+  tokens.CheckBadFortranCharacters(
+      messages_, *this, disableSourceContinuation_);
   // Parenthesis nesting check does not apply while any #include is
   // active, nor on the lines before and after a top-level #include.
   // Applications play shenanigans with line continuation before and
@@ -1243,7 +1262,9 @@ bool Prescanner::IsImplicitContinuation() const {
 }
 
 bool Prescanner::Continuation(bool mightNeedFixedFormSpace) {
-  if (*at_ == '\n' || *at_ == '&') {
+  if (disableSourceContinuation_) {
+    return false;
+  } else if (*at_ == '\n' || *at_ == '&') {
     if (inFixedForm_) {
       return FixedFormContinuation(mightNeedFixedFormSpace);
     } else {
@@ -1255,8 +1276,9 @@ bool Prescanner::Continuation(bool mightNeedFixedFormSpace) {
     BeginSourceLine(nextLine_);
     NextLine();
     return true;
+  } else {
+    return false;
   }
-  return false;
 }
 
 std::optional<Prescanner::LineClassification>
@@ -1418,6 +1440,17 @@ Prescanner::LineClassification Prescanner::ClassifyLine(
   return {LineClassification::Kind::Source};
 }
 
+Prescanner::LineClassification Prescanner::ClassifyLine(
+    TokenSequence &tokens, Provenance newlineProvenance) const {
+  // Append a newline temporarily.
+  tokens.PutNextTokenChar('\n', newlineProvenance);
+  tokens.CloseToken();
+  const char *ppd{tokens.ToCharBlock().begin()};
+  LineClassification classification{ClassifyLine(ppd)};
+  tokens.pop_back(); // remove the newline
+  return classification;
+}
+
 void Prescanner::SourceFormChange(std::string &&dir) {
   if (dir == "!dir$ free") {
     inFixedForm_ = false;
@@ -1445,7 +1478,7 @@ bool Prescanner::CompilerDirectiveContinuation(
     return true;
   }
   CHECK(origSentinel != nullptr);
-  directiveSentinel_ = origSentinel; // so IsDirective() is true
+  directiveSentinel_ = origSentinel; // so InCompilerDirective() is true
   const char *nextContinuation{
       followingLine.kind == LineClassification::Kind::CompilerDirective
           ? FreeFormContinuationLine(true)
@@ -1457,7 +1490,6 @@ bool Prescanner::CompilerDirectiveContinuation(
   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.
@@ -1467,6 +1499,7 @@ bool Prescanner::CompilerDirectiveContinuation(
     // but might become a directive continuation afterwards.
     SkipSpaces();
   }
+  TokenSequence followingTokens;
   while (NextToken(followingTokens)) {
   }
   if (auto followingPrepro{
@@ -1475,25 +1508,31 @@ bool Prescanner::CompilerDirectiveContinuation(
   }
   followingTokens.RemoveRedundantBlanks();
   std::size_t startAt{0};
-  std::size_t keep{followingTokens.SizeInTokens()};
+  std::size_t following{followingTokens.SizeInTokens()};
   bool ok{false};
   if (nextContinuation) {
     ok = true;
   } else {
-    if (keep >= 3 && followingTokens.TokenAt(0) == "!" &&
-        followingTokens.TokenAt(2) == "&") {
+    startAt = 2;
+    if (startAt < following && followingTokens.TokenAt(0) == "!") {
       CharBlock sentinel{followingTokens.TokenAt(1)};
       if (!sentinel.empty() &&
           std::memcmp(sentinel.begin(), origSentinel, sentinel.size()) == 0) {
-        startAt = 3;
-        keep -= 3;
         ok = true;
+        while (
+            startAt < following && followingTokens.TokenAt(startAt).IsBlank()) {
+          ++startAt;
+        }
+        if (startAt < following && followingTokens.TokenAt(startAt) == "&") {
+          ++startAt;
+        }
       }
     }
   }
   if (ok) {
     tokens.pop_back(); // delete original '&'
-    tokens.Put(followingTokens, startAt, keep);
+    tokens.Put(followingTokens, startAt, following - startAt);
+    tokens.RemoveRedundantBlanks();
   } else {
     nextLine_ = origNextLine;
   }

flang/lib/Parser/prescan.h

@@ -94,6 +94,7 @@ class Prescanner {
     LineClassification(Kind k, std::size_t po = 0, const char *s = nullptr)
         : kind{k}, payloadOffset{po}, sentinel{s} {}
     LineClassification(LineClassification &&) = default;
+    LineClassification &operator=(LineClassification &&) = default;
     Kind kind;
     std::size_t payloadOffset; // byte offset of content
     const char *sentinel; // if it's a compiler directive
@@ -117,6 +118,7 @@ class Prescanner {
     parenthesisNesting_ = 0;
     continuationLines_ = 0;
     isPossibleMacroCall_ = false;
+    disableSourceContinuation_ = false;
   }
 
   Provenance GetProvenance(const char *sourceChar) const {
@@ -192,6 +194,8 @@ class Prescanner {
   std::optional<LineClassification> IsFreeFormCompilerDirectiveLine(
       const char *) const;
   LineClassification ClassifyLine(const char *) const;
+  LineClassification ClassifyLine(
+      TokenSequence &, Provenance newlineProvenance) const;
   void SourceFormChange(std::string &&);
   bool CompilerDirectiveContinuation(TokenSequence &, const char *sentinel);
   bool SourceLineContinuation(TokenSequence &);
@@ -211,6 +215,7 @@ class Prescanner {
   int continuationLines_{0};
   bool isPossibleMacroCall_{false};
   bool afterIncludeDirective_{false};
+  bool disableSourceContinuation_{false};
 
   Provenance startProvenance_;
   const char *start_{nullptr}; // beginning of current source file content

flang/lib/Parser/token-sequence.cpp

@@ -347,7 +347,8 @@ ProvenanceRange TokenSequence::GetProvenanceRange() const {
 }
 
 const TokenSequence &TokenSequence::CheckBadFortranCharacters(
-    Messages &messages, const Prescanner &prescanner) const {
+    Messages &messages, const Prescanner &prescanner,
+    bool allowAmpersand) const {
   std::size_t tokens{SizeInTokens()};
   for (std::size_t j{0}; j < tokens; ++j) {
     CharBlock token{TokenAt(j)};
@@ -362,6 +363,8 @@ const TokenSequence &TokenSequence::CheckBadFortranCharacters(
           ++j;
           continue;
         }
+      } else if (ch == '&' && allowAmpersand) {
+        continue;
       }
       if (ch < ' ' || ch >= '\x7f') {
         messages.Say(GetTokenProvenanceRange(j),

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

@@ -1,12 +1,17 @@
-! RUN: %flang -E %s 2>&1 | FileCheck %s
+! RUN: %flang -fc1 -fdebug-unparse -fopenmp %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 &
+#define COMMENT !
+#define OMP_START !$omp
+#define OMP_CONT !$omp&
 
-subroutine s(x1, x2, x3, x4, x5, x6, x7)
+module m
+ contains
+  subroutine s(x1, x2, x3, x4, x5, x6, x7)
 
 !dir$ ignore_tkr x1
 
@@ -24,18 +29,48 @@ subroutine s(x1, x2, x3, x4, x5, x6, x7)
 FIRST(ignore_tkr &)
 NEXT(x6)
 
-FIRST(ignore_tkr &)
-NEXT(x7 &)
-NEXT(x8)
+COMMENT blah &
+COMMENT & more
+    stop 1
+
+OMP_START parallel &
+OMP_START do &
+OMP_START reduction(+:x)
+    do j1 = 1, n
+    end do
+
+OMP_START parallel &
+OMP_START & do &
+OMP_START & reduction(+:x)
+    do j2 = 1, n
+    end do
 
+OMP_START parallel &
+OMP_CONT do &
+OMP_CONT reduction(+:x)
+    do j3 = 1, n
+    end do
+  end
 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
+!CHECK: MODULE m
+!CHECK: CONTAINS
+!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:   STOP 1_4
+!CHECK: !$OMP PARALLEL DO  REDUCTION(+:x)
+!CHECK:   DO j1=1_4,n
+!CHECK:   END DO
+!CHECK: !$OMP PARALLEL DO  REDUCTION(+:x)
+!CHECK:   DO j2=1_4,n
+!CHECK:   END DO
+!CHECK: !$OMP PARALLEL DO  REDUCTION(+:x)
+!CHECK:   DO j3=1_4,n
+!CHECK:   END DO
+!CHECK:  END SUBROUTINE
+!CHECK: END MODULE