[flang] checkpoint

Original-commit: flang-compiler/f18@0c9bdc70328e3e6fb752c84c84f5d6cda0b4316d
Reviewed-on: https://github.com/flang-compiler/f18/pull/333
Tree-same-pre-rewrite: false

diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h
index 6d99f4a..c75958d 100644 (file)
--- a/flang/lib/parser/grammar.h
+++ b/flang/lib/parser/grammar.h
@@ -3396,16 +3396,16 @@ TYPE_CONTEXT_PARSER("statement function definition"_en_US,
         name, parenthesized(optionalList(name)), "=" >> scalar(expr)))
 
 // Directives, extensions, and deprecated statements
-// !DIR$ IVDEP
 // !DIR$ IGNORE_TKR [ [(tkr...)] name ]...
+// !DIR$ name...
 constexpr auto beginDirective{skipStuffBeforeStatement >> "!"_ch};
 constexpr auto endDirective{space >> endOfLine};
-constexpr auto ivdep{construct<CompilerDirective::IVDEP>("DIR$ IVDEP"_tok)};
 constexpr auto ignore_tkr{
     "DIR$ IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(
                              defaulted(parenthesized(some("tkr"_ch))), name))};
-TYPE_PARSER(beginDirective >> sourced(construct<CompilerDirective>(ivdep) ||
-                                  construct<CompilerDirective>(ignore_tkr)) /
+TYPE_PARSER(
+    beginDirective >> sourced(construct<CompilerDirective>(ignore_tkr) ||
+                          construct<CompilerDirective>("DIR$" >> many(name))) /
         endDirective)
 
 TYPE_PARSER(extension<LanguageFeature::CrayPointer>(

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index d303bd8..936bae6 100644 (file)
--- a/flang/lib/parser/parse-tree.h
+++ b/flang/lib/parser/parse-tree.h
@@ -3154,17 +3154,16 @@ struct StmtFunctionStmt {
 };
 
 // Compiler directives
-// !DIR$ IVDEP
 // !DIR$ IGNORE_TKR [ [(tkr...)] name ]...
+// !DIR$ name...
 struct CompilerDirective {
   UNION_CLASS_BOILERPLATE(CompilerDirective);
   struct IgnoreTKR {
     TUPLE_CLASS_BOILERPLATE(IgnoreTKR);
     std::tuple<std::list<const char *>, Name> t;
   };
-  EMPTY_CLASS(IVDEP);
   CharBlock source;
-  std::variant<std::list<IgnoreTKR>, IVDEP> u;
+  std::variant<std::list<IgnoreTKR>, std::list<Name>> u;
 };
 
 // Legacy extensions

diff --git a/flang/lib/parser/preprocessor.cc b/flang/lib/parser/preprocessor.cc
index e6810ba..92ac42b 100644 (file)
--- a/flang/lib/parser/preprocessor.cc
+++ b/flang/lib/parser/preprocessor.cc
@@ -809,133 +809,139 @@ static std::int64_t ExpressionValue(const TokenSequence &token,
     default: CRASH_NO_CASE;
     }
   }
-  if (*atToken >= tokens) {
-    return left;
-  }
 
-  // Parse and evaluate a binary operator and its second operand, if present.
-  int advance{1};
-  t = token.TokenAt(*atToken).ToString();
-  if (t == "." && *atToken + 2 < tokens &&
-      token.TokenAt(*atToken + 2).ToString() == ".") {
-    t += ToLowerCaseLetters(token.TokenAt(*atToken + 1).ToString()) + '.';
-    advance = 3;
-  }
-  auto it{opNameMap.find(t)};
-  if (it == opNameMap.end()) {
-    return left;
-  }
-  op = it->second;
-  if (op < POWER || precedence[op] < minimumPrecedence) {
-    return left;
-  }
-  opAt = *atToken;
-  *atToken += advance;
-  std::int64_t right{
-      ExpressionValue(token, operandPrecedence[op], atToken, error)};
-  if (error->has_value()) {
-    return 0;
-  }
-  switch (op) {
-  case POWER:
-    if (left == 0 && right < 0) {
-      *error = Message{
-          token.GetTokenProvenanceRange(opAt), "0 ** negative power"_err_en_US};
-      return 0;
+  // Parse and evaluate binary operators and their second operands, if present.
+  while (*atToken < tokens) {
+    int advance{1};
+    t = token.TokenAt(*atToken).ToString();
+    if (t == "." && *atToken + 2 < tokens &&
+        token.TokenAt(*atToken + 2).ToString() == ".") {
+      t += ToLowerCaseLetters(token.TokenAt(*atToken + 1).ToString()) + '.';
+      advance = 3;
+    }
+    auto it{opNameMap.find(t)};
+    if (it == opNameMap.end()) {
+      break;
     }
-    if (left == 0 || left == 1 || right == 1) {
-      return left;
+    op = it->second;
+    if (op < POWER || precedence[op] < minimumPrecedence) {
+      break;
     }
-    if (right <= 0) {
-      return !right;
+    opAt = *atToken;
+    *atToken += advance;
+
+    std::int64_t right{
+        ExpressionValue(token, operandPrecedence[op], atToken, error)};
+    if (error->has_value()) {
+      return 0;
     }
-    {
-      std::int64_t power{1};
-      for (; right > 0; --right) {
-        if ((power * left) / left != power) {
+
+    switch (op) {
+    case POWER:
+      if (left == 0) {
+        if (right < 0) {
           *error = Message{token.GetTokenProvenanceRange(opAt),
-              "overflow in exponentation"_err_en_US};
-          return 0;
+              "0 ** negative power"_err_en_US};
+        }
+      } else if (left != 1 && right != 1) {
+        if (right <= 0) {
+          left = !right;
+        } else {
+          std::int64_t power{1};
+          for (; right > 0; --right) {
+            if ((power * left) / left != power) {
+              *error = Message{token.GetTokenProvenanceRange(opAt),
+                  "overflow in exponentation"_err_en_US};
+              left = 1;
+            }
+            power *= left;
+          }
+          left = power;
         }
-        power *= left;
       }
-      return power;
-    }
-  case TIMES:
-    if (left == 0 || right == 0) {
-      return 0;
-    }
-    if ((left * right) / left != right) {
-      *error = Message{token.GetTokenProvenanceRange(opAt),
-          "overflow in multiplication"_err_en_US};
-    }
-    return left * right;
-  case DIVIDE:
-    if (right == 0) {
-      *error = Message{
-          token.GetTokenProvenanceRange(opAt), "division by zero"_err_en_US};
-      return 0;
-    }
-    return left / right;
-  case MODULUS:
-    if (right == 0) {
-      *error = Message{
-          token.GetTokenProvenanceRange(opAt), "modulus by zero"_err_en_US};
-      return 0;
-    }
-    return left % right;
-  case ADD:
-    if ((left < 0) == (right < 0) && (left < 0) != (left + right < 0)) {
-      *error = Message{token.GetTokenProvenanceRange(opAt),
-          "overflow in addition"_err_en_US};
-    }
-    return left + right;
-  case SUBTRACT:
-    if ((left < 0) != (right < 0) && (left < 0) == (left - right < 0)) {
-      *error = Message{token.GetTokenProvenanceRange(opAt),
-          "overflow in subtraction"_err_en_US};
-    }
-    return left - right;
-  case LEFTSHIFT:
-    if (right < 0 || right > 64) {
-      *error = Message{token.GetTokenProvenanceRange(opAt),
-          "bad left shift count"_err_en_US};
-    }
-    return right >= 64 ? 0 : left << right;
-  case RIGHTSHIFT:
-    if (right < 0 || right > 64) {
-      *error = Message{token.GetTokenProvenanceRange(opAt),
-          "bad right shift count"_err_en_US};
-    }
-    return right >= 64 ? 0 : left >> right;
-  case BITAND:
-  case AND: return left & right;
-  case BITXOR: return left ^ right;
-  case BITOR:
-  case OR: return left | right;
-  case LT: return -(left < right);
-  case LE: return -(left <= right);
-  case EQ: return -(left == right);
-  case NE: return -(left != right);
-  case GE: return -(left >= right);
-  case GT: return -(left > right);
-  case EQV: return -(!left == !right);
-  case NEQV: return -(!left != !right);
-  case SELECT:
-    if (*atToken >= tokens || token.TokenAt(*atToken).ToString() != ":") {
-      *error = Message{token.GetTokenProvenanceRange(opAt),
-          "':' required in selection expression"_err_en_US};
-      return left;
-    } else {
-      ++*atToken;
-      std::int64_t third{
-          ExpressionValue(token, operandPrecedence[op], atToken, error)};
-      return left != 0 ? right : third;
+      break;
+    case TIMES:
+      if (left != 0 && right != 0 && ((left * right) / left) != right) {
+        *error = Message{token.GetTokenProvenanceRange(opAt),
+            "overflow in multiplication"_err_en_US};
+      }
+      left = left * right;
+      break;
+    case DIVIDE:
+      if (right == 0) {
+        *error = Message{
+            token.GetTokenProvenanceRange(opAt), "division by zero"_err_en_US};
+        left = 0;
+      } else {
+        left = left / right;
+      }
+      break;
+    case MODULUS:
+      if (right == 0) {
+        *error = Message{
+            token.GetTokenProvenanceRange(opAt), "modulus by zero"_err_en_US};
+        left = 0;
+      } else {
+        left = left % right;
+      }
+      break;
+    case ADD:
+      if ((left < 0) == (right < 0) && (left < 0) != (left + right < 0)) {
+        *error = Message{token.GetTokenProvenanceRange(opAt),
+            "overflow in addition"_err_en_US};
+      }
+      left = left + right;
+      break;
+    case SUBTRACT:
+      if ((left < 0) != (right < 0) && (left < 0) == (left - right < 0)) {
+        *error = Message{token.GetTokenProvenanceRange(opAt),
+            "overflow in subtraction"_err_en_US};
+      }
+      left = left - right;
+      break;
+    case LEFTSHIFT:
+      if (right < 0 || right > 64) {
+        *error = Message{token.GetTokenProvenanceRange(opAt),
+            "bad left shift count"_err_en_US};
+      }
+      left = right >= 64 ? 0 : left << right;
+      break;
+    case RIGHTSHIFT:
+      if (right < 0 || right > 64) {
+        *error = Message{token.GetTokenProvenanceRange(opAt),
+            "bad right shift count"_err_en_US};
+      }
+      left = right >= 64 ? 0 : left >> right;
+      break;
+    case BITAND:
+    case AND: left = left & right; break;
+    case BITXOR: left = left ^ right; break;
+    case BITOR:
+    case OR: left = left | right; break;
+    case LT: left = -(left < right); break;
+    case LE: left = -(left <= right); break;
+    case EQ: left = -(left == right); break;
+    case NE: left = -(left != right); break;
+    case GE: left = -(left >= right); break;
+    case GT: left = -(left > right); break;
+    case EQV: left = -(!left == !right); break;
+    case NEQV: left = -(!left != !right); break;
+    case SELECT:
+      if (*atToken >= tokens || token.TokenAt(*atToken).ToString() != ":") {
+        *error = Message{token.GetTokenProvenanceRange(opAt),
+            "':' required in selection expression"_err_en_US};
+        return 0;
+      } else {
+        ++*atToken;
+        std::int64_t third{
+            ExpressionValue(token, operandPrecedence[op], atToken, error)};
+        left = left != 0 ? right : third;
+      }
+    case COMMA: left = right; break;
+    default: CRASH_NO_CASE;
     }
-  case COMMA: return right;
-  default: CRASH_NO_CASE;
   }
-  return 0;  // silence compiler warning
+  return left;
 }
 
 bool Preprocessor::IsIfPredicateTrue(const TokenSequence &expr,

diff --git a/flang/lib/parser/prescan.cc b/flang/lib/parser/prescan.cc
index 7e07b23..c311e19 100644 (file)
--- a/flang/lib/parser/prescan.cc
+++ b/flang/lib/parser/prescan.cc
@@ -96,11 +96,12 @@ void Prescanner::Statement() {
   LineClassification line{ClassifyLine(lineStart_)};
   switch (line.kind) {
   case LineClassification::Kind::Comment: NextLine(); return;
-  case LineClassification::Kind::Include:
+  case LineClassification::Kind::IncludeLine:
     FortranInclude(lineStart_ + line.payloadOffset);
     NextLine();
     return;
   case LineClassification::Kind::ConditionalCompilationDirective:
+  case LineClassification::Kind::IncludeDirective:
   case LineClassification::Kind::PreprocessorDirective:
     preprocessor_.Directive(TokenizePreprocessorDirective(), this);
     return;
@@ -161,12 +162,14 @@ void Prescanner::Statement() {
     preprocessed->CloseToken();
     const char *ppd{preprocessed->ToCharBlock().begin()};
     LineClassification ppl{ClassifyLine(ppd)};
+    preprocessed->ReopenLastToken();  // remove the newline
     switch (ppl.kind) {
     case LineClassification::Kind::Comment: break;
-    case LineClassification::Kind::Include:
+    case LineClassification::Kind::IncludeLine:
       FortranInclude(ppd + ppl.payloadOffset);
       break;
     case LineClassification::Kind::ConditionalCompilationDirective:
+    case LineClassification::Kind::IncludeDirective:
     case LineClassification::Kind::PreprocessorDirective:
       Say(preprocessed->GetProvenanceRange(),
           "preprocessed line resembles a preprocessor directive"_en_US);
@@ -200,6 +203,10 @@ void Prescanner::Statement() {
       SourceFormChange(tokens.ToString());
     }
     tokens.Emit(cooked_);
+  }
+  if (omitNewline_) {
+    omitNewline_ = false;
+  } else {
     cooked_.Put('\n', newlineProvenance);
   }
   directiveSentinel_ = nullptr;
@@ -668,21 +675,34 @@ bool Prescanner::IsNextLinePreprocessorDirective() const {
   return IsPreprocessorDirectiveLine(lineStart_) != nullptr;
 }
 
-bool Prescanner::SkipCommentLine() {
+bool Prescanner::SkipCommentLine(bool afterAmpersand) {
   if (lineStart_ >= limit_) {
+    if (afterAmpersand && prescannerNesting_ > 0) {
+      // A continuation marker at the end of the last line in an
+      // include file inhibits the newline.
+      SkipToEndOfLine();
+      omitNewline_ = true;
+    }
     return false;
   }
   auto lineClass{ClassifyLine(lineStart_)};
   if (lineClass.kind == LineClassification::Kind::Comment) {
     NextLine();
     return true;
-  } else if (!inPreprocessorDirective_ &&
-      lineClass.kind ==
-          LineClassification::Kind::ConditionalCompilationDirective) {
+  } else if (inPreprocessorDirective_) {
+    return false;
+  } else if (lineClass.kind ==
+      LineClassification::Kind::ConditionalCompilationDirective) {
     // Allow conditional compilation directives (e.g., #ifdef) to affect
     // continuation lines.
     preprocessor_.Directive(TokenizePreprocessorDirective(), this);
     return true;
+  } else if (afterAmpersand &&
+      (lineClass.kind == LineClassification::Kind::IncludeDirective ||
+          lineClass.kind == LineClassification::Kind::IncludeLine)) {
+    SkipToEndOfLine();
+    omitNewline_ = true;
+    return false;
   } else {
     return false;
   }
@@ -783,7 +803,7 @@ const char *Prescanner::FreeFormContinuationLine(bool ampersand) {
   } else {
     if (*p == '&') {
       return p + 1;
-    } else if (*p == '!' || *p == '\n') {
+    } else if (*p == '!' || *p == '\n' || *p == '#') {
       return nullptr;
     } else if (ampersand || delimiterNesting_ > 0) {
       if (p > lineStart_) {
@@ -811,7 +831,7 @@ bool Prescanner::FixedFormContinuation(bool mightNeedSpace) {
       NextLine();
       return true;
     }
-  } while (SkipCommentLine());
+  } while (SkipCommentLine(false));
   return false;
 }
 
@@ -830,7 +850,7 @@ bool Prescanner::FreeFormContinuation() {
       NextLine();
       return true;
     }
-  } while (SkipCommentLine());
+  } while (SkipCommentLine(ampersand));
   return false;
 }
 
@@ -953,12 +973,14 @@ Prescanner::LineClassification Prescanner::ClassifyLine(
     }
   }
   if (std::optional<std::size_t> quoteOffset{IsIncludeLine(start)}) {
-    return {LineClassification::Kind::Include, *quoteOffset};
+    return {LineClassification::Kind::IncludeLine, *quoteOffset};
   }
   if (const char *dir{IsPreprocessorDirectiveLine(start)}) {
     if (std::memcmp(dir, "if", 2) == 0 || std::memcmp(dir, "elif", 4) == 0 ||
         std::memcmp(dir, "else", 4) == 0 || std::memcmp(dir, "endif", 5) == 0) {
       return {LineClassification::Kind::ConditionalCompilationDirective};
+    } else if (std::memcmp(dir, "include", 7) == 0) {
+      return {LineClassification::Kind::IncludeDirective};
     } else {
       return {LineClassification::Kind::PreprocessorDirective};
     }

diff --git a/flang/lib/parser/prescan.h b/flang/lib/parser/prescan.h
index b11925f..7cc3ddc 100644 (file)
--- a/flang/lib/parser/prescan.h
+++ b/flang/lib/parser/prescan.h
@@ -82,8 +82,9 @@ private:
     enum class Kind {
       Comment,
       ConditionalCompilationDirective,
+      IncludeDirective,  // #include
       PreprocessorDirective,
-      Include,
+      IncludeLine,  // Fortran INCLUDE
       CompilerDirective,
       Source
     };
@@ -149,7 +150,7 @@ private:
   void QuotedCharacterLiteral(TokenSequence &);
   void Hollerith(TokenSequence &, int count, const char *start);
   bool PadOutCharacterLiteral(TokenSequence &);
-  bool SkipCommentLine();
+  bool SkipCommentLine(bool afterAmpersand);
   bool IsFixedFormCommentLine(const char *) const;
   bool IsFreeFormComment(const char *) const;
   std::optional<std::size_t> IsIncludeLine(const char *) const;
@@ -198,6 +199,13 @@ private:
   // setting this flag, which is cleared by EmitChar().
   bool insertASpace_{false};
 
+  // When a free form continuation marker (&) appears at the end of a line
+  // before a INCLUDE or #include, we delete it and omit the newline, so
+  // that the first line of the included file is truly a continuation of
+  // the line before.  Also used when the & appears at the end of the last
+  // line in an include file.
+  bool omitNewline_{false};
+
   const Provenance spaceProvenance_{
       cooked_.allSources().CompilerInsertionProvenance(' ')};
   const Provenance backslashProvenance_{

diff --git a/flang/lib/parser/unparse.cc b/flang/lib/parser/unparse.cc
index 805cf48..f34ef09 100644 (file)
--- a/flang/lib/parser/unparse.cc
+++ b/flang/lib/parser/unparse.cc
@@ -1746,10 +1746,10 @@ public:
     std::visit(
         common::visitors{
             [&](const std::list<CompilerDirective::IgnoreTKR> &tkr) {
-              Word("!DIR$ IGNORE_TKR");
+              Word("!DIR$ IGNORE_TKR");  // emitted even if tkr list is empty
               Walk(" ", tkr, ", ");
             },
-            [&](const CompilerDirective::IVDEP &) { Word("!DIR$ IVDEP\n"); },
+            [&](const std::list<Name> &names) { Walk("!DIR$ ", names, " "); },
         },
         x.u);
     Put('\n');

diff --git a/flang/lib/semantics/dump-parse-tree.h b/flang/lib/semantics/dump-parse-tree.h
index 436314f..51b73d4 100644 (file)
--- a/flang/lib/semantics/dump-parse-tree.h
+++ b/flang/lib/semantics/dump-parse-tree.h
@@ -139,7 +139,6 @@ public:
   NODE(parser, CommonStmt)
   NODE(parser::CommonStmt, Block)
   NODE(parser, CompilerDirective)
-  NODE(parser::CompilerDirective, IVDEP)
   NODE(parser::CompilerDirective, IgnoreTKR)
   NODE(parser, ComplexLiteralConstant)
   NODE(parser, ComplexPart)