[flang] Don't check fixed form label field too early

[klausler]

When a fixed form source line begins with the name of a macro, don't emit the usual warning message about a non-decimal character in the label field. (The check for a macro was only being applied to free form source lines, and the label field checking was unconditional).

Fixes #116914.

[llvmbot]

@llvm/pr-subscribers-flang-parser

Author: Peter Klausler (klausler)

Changes

When a fixed form source line begins with the name of a macro, don't emit the usual warning message about a non-decimal character in the label field. (The check for a macro was only being applied to free form source lines, and the label field checking was unconditional).

Fixes #116914.

---

Full diff: https://github.com/llvm/llvm-project/pull/117040.diff

2 Files Affected:

• (modified) flang/lib/Parser/prescan.cpp (+35-30)
• (added) flang/test/Preprocessing/pp046.F (+5)

diff --git a/flang/lib/Parser/prescan.cpp b/flang/lib/Parser/prescan.cpp
index 1d2f1e97668792..b1206c9c09319b 100644
--- a/flang/lib/Parser/prescan.cpp
+++ b/flang/lib/Parser/prescan.cpp
@@ -188,14 +188,15 @@ void Prescanner::Statement() {
     }
     break;
   }
-  case LineClassification::Kind::Source:
+  case LineClassification::Kind::Source: {
     BeginStatementAndAdvance();
+    bool checkLabelField{false};
     if (inFixedForm_) {
       if (features_.IsEnabled(LanguageFeature::OldDebugLines) &&
           (*at_ == 'D' || *at_ == 'd')) {
         NextChar();
       }
-      LabelField(tokens);
+      checkLabelField = true;
     } else {
       if (skipLeadingAmpersand_) {
         skipLeadingAmpersand_ = false;
@@ -207,38 +208,42 @@ 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_)) {
-        // TODO: Only bother with these cases when any keyword macro has
-        // been defined with replacement text that could begin a comment
-        // or directive sentinel.
-        const char *p{at_};
-        while (IsLegalInIdentifier(*++p)) {
-        }
-        CharBlock id{at_, static_cast<std::size_t>(p - at_)};
-        if (preprocessor_.IsNameDefined(id) &&
-            !preprocessor_.IsFunctionLikeDefinition(id)) {
-          TokenSequence toks;
-          toks.Put(id, GetProvenance(at_));
-          if (auto replaced{preprocessor_.MacroReplacement(toks, *this)}) {
-            auto newLineClass{ClassifyLine(*replaced, GetCurrentProvenance())};
-            if (newLineClass.kind ==
-                LineClassification::Kind::CompilerDirective) {
-              directiveSentinel_ = newLineClass.sentinel;
-              disableSourceContinuation_ = false;
-            } else {
-              disableSourceContinuation_ =
-                  newLineClass.kind != LineClassification::Kind::Source;
-            }
+    }
+    // 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_)) {
+      // TODO: Only bother with these cases when any keyword macro has
+      // been defined with replacement text that could begin a comment
+      // or directive sentinel.
+      const char *p{at_};
+      while (IsLegalInIdentifier(*++p)) {
+      }
+      CharBlock id{at_, static_cast<std::size_t>(p - at_)};
+      if (preprocessor_.IsNameDefined(id) &&
+          !preprocessor_.IsFunctionLikeDefinition(id)) {
+        checkLabelField = false;
+        TokenSequence toks;
+        toks.Put(id, GetProvenance(at_));
+        if (auto replaced{preprocessor_.MacroReplacement(toks, *this)}) {
+          auto newLineClass{ClassifyLine(*replaced, GetCurrentProvenance())};
+          if (newLineClass.kind ==
+              LineClassification::Kind::CompilerDirective) {
+            directiveSentinel_ = newLineClass.sentinel;
+            disableSourceContinuation_ = false;
+          } else {
+            disableSourceContinuation_ =
+                newLineClass.kind != LineClassification::Kind::Source;
           }
         }
       }
     }
-    break;
+    if (checkLabelField) {
+      LabelField(tokens);
+    }
+  } break;
   }
 
   while (NextToken(tokens)) {
diff --git a/flang/test/Preprocessing/pp046.F b/flang/test/Preprocessing/pp046.F
new file mode 100644
index 00000000000000..38e426a6248237
--- /dev/null
+++ b/flang/test/Preprocessing/pp046.F
@@ -0,0 +1,5 @@
+! RUN: %flang -E %s 2>&1 | FileCheck %s
+! CHECK-NOT: Character in fixed-form label field must be a digit
+#define KWM !
+KWM a comment
+      end

[psteinfeld]

This change gets rid of the warning, but it still doesn't pass the original test case. When I run the original test case through gfortran using the command gfortran -ffixed-form -E bug116914.F, I get:

# 1 "bug116914.F"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "bug116914.F"

!! A Comment line

When I run this test case though flang after building with this update I get an empy line as output.

[klausler]

That's right; we remove the comment line from the preprocessed output.

[psteinfeld]

All builds and tests correctly and looks good.