[flang] Check int literals for overflow when kind is known.

improve test

Original-commit: flang-compiler/f18@09ce783cd30e6d70829d0b5596fe8f3e0f88c64f
Reviewed-on: https://github.com/flang-compiler/f18/pull/352
Tree-same-pre-rewrite: false

diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md
index c495a40..d4190db 100644 (file)
--- a/flang/documentation/Extensions.md
+++ b/flang/documentation/Extensions.md
@@ -60,6 +60,8 @@ Extensions, deletions, and legacy features supported by default
   need not begin with a comment marker (!).
 * Classic C-style /*comments*/ are skipped, so multi-language header
   files are easier to write and use.
+* $ and \ edit descriptors are supported in FORMAT to suppress newline
+  output on user prompts.
 
 Extensions supported when enabled by options
 --------------------------------------------

diff --git a/flang/lib/evaluate/integer.h b/flang/lib/evaluate/integer.h
index e6be829..b0b9189 100644 (file)
--- a/flang/lib/evaluate/integer.h
+++ b/flang/lib/evaluate/integer.h
@@ -219,16 +219,18 @@ public:
     return result;
   }
 
-  static constexpr ValueWithOverflow ReadUnsigned(
-      const char *&pp, std::uint64_t base = 10) {
+  static constexpr ValueWithOverflow Read(
+      const char *&pp, std::uint64_t base = 10, bool isSigned = false) {
     Integer result;
     bool overflow{false};
     const char *p{pp};
     while (*p == ' ' || *p == '\t') {
       ++p;
     }
-    if (*p == '+') {
-      ++p;
+    bool negate{*p == '-'};
+    if (negate || *p == '+') {
+      while (*++p == ' ' || *p == '\t') {
+      }
     }
     Integer radix{base};
     // This code makes assumptions about local contiguity in regions of the
@@ -256,6 +258,12 @@ public:
       result = next.value;
     }
     pp = p;
+    if (negate) {
+      result = result.Negate().value;
+      overflow |= isSigned && !result.IsNegative() && !result.IsZero();
+    } else {
+      overflow |= isSigned && result.IsNegative();
+    }
     return {result, overflow};
   }
 

diff --git a/flang/lib/parser/dump-parse-tree.h b/flang/lib/parser/dump-parse-tree.h
index 4d59a0a..f427b1a 100644 (file)
--- a/flang/lib/parser/dump-parse-tree.h
+++ b/flang/lib/parser/dump-parse-tree.h
@@ -336,7 +336,6 @@ public:
   NODE(parser, InterfaceStmt)
   NODE(parser, InternalSubprogram)
   NODE(parser, InternalSubprogramPart)
-  NODE(parser, IntLiteralConstant)
   NODE(parser, Intrinsic)
   NODE(parser, IntrinsicStmt)
   NODE(parser, IntrinsicTypeSpec)
@@ -636,7 +635,6 @@ public:
   NODE(parser, SequenceStmt)
   NODE(parser, Sign)
   NODE(parser, SignedComplexLiteralConstant)
-  NODE(parser, SignedIntLiteralConstant)
   NODE(parser, SignedRealLiteralConstant)
   NODE(parser, SpecificationConstruct)
   NODE(parser, SpecificationExpr)
@@ -769,6 +767,24 @@ public:
 
   void Post(const std::uint64_t &x) { --indent_; }
 
+  bool Pre(const parser::IntLiteralConstant &x) {
+    IndentEmptyLine();
+    out_ << "int = '" << std::get<parser::CharBlock>(x.t).ToString() << '\'';
+    ++indent_;
+    EndLine();
+    return true;
+  }
+  void Post(const parser::IntLiteralConstant &) { --indent_; }
+
+  bool Pre(const parser::SignedIntLiteralConstant &x) {
+    IndentEmptyLine();
+    out_ << "int = '" << std::get<parser::CharBlock>(x.t).ToString() << '\'';
+    ++indent_;
+    EndLine();
+    return true;
+  }
+  void Post(const parser::SignedIntLiteralConstant &) { --indent_; }
+
   // A few types we want to ignore
 
   bool Pre(const parser::CharBlock &) { return true; }

diff --git a/flang/lib/parser/format-specification.h b/flang/lib/parser/format-specification.h
index 98c3255..8d620d4 100644 (file)
--- a/flang/lib/parser/format-specification.h
+++ b/flang/lib/parser/format-specification.h
@@ -100,8 +100,8 @@ struct ControlEditDesc {
     RP,
     DC,
     DP,
-    Dollar,
-    Backslash,
+    Dollar,  // extension: inhibit newline on output
+    Backslash,  // ditto, but only on terminals
   };
   ControlEditDesc() = delete;
   ControlEditDesc(ControlEditDesc &&) = default;

diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h
index d2d1240..ee14827 100644 (file)
--- a/flang/lib/parser/grammar.h
+++ b/flang/lib/parser/grammar.h
@@ -561,7 +561,7 @@ TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))
 TYPE_PARSER(construct<KindSelector>(
                 parenthesized(maybe("KIND ="_tok) >> scalarIntConstantExpr)) ||
     extension<LanguageFeature::StarKind>(construct<KindSelector>(
-        construct<KindSelector::StarSize>("*" >> digitString / spaceCheck))))
+        construct<KindSelector::StarSize>("*" >> digitString64 / spaceCheck))))
 
 // R707 signed-int-literal-constant -> [sign] int-literal-constant
 TYPE_PARSER(sourced(construct<SignedIntLiteralConstant>(
@@ -574,7 +574,7 @@ TYPE_PARSER(construct<IntLiteralConstant>(
     space >> digitString, maybe(underscore >> kindParam) / !underscore))
 
 // R709 kind-param -> digit-string | scalar-int-constant-name
-TYPE_PARSER(construct<KindParam>(digitString) ||
+TYPE_PARSER(construct<KindParam>(digitString64) ||
     construct<KindParam>(scalar(integer(constant(name)))))
 
 // R712 sign -> + | -
@@ -602,13 +602,12 @@ constexpr auto exponentPart{
 TYPE_CONTEXT_PARSER("REAL literal constant"_en_US,
     space >>
         construct<RealLiteralConstant>(
-            sourced(
-                (skipDigitString >> "."_ch >>
-                        !(some(letter) >>
-                            "."_ch /* don't misinterpret 1.AND. */) >>
-                        maybe(skipDigitString) >> maybe(exponentPart) >> ok ||
-                    "."_ch >> skipDigitString >> maybe(exponentPart) >> ok ||
-                    skipDigitString >> exponentPart >> ok) >>
+            sourced((digitString >> "."_ch >>
+                            !(some(letter) >>
+                                "."_ch /* don't misinterpret 1.AND. */) >>
+                            maybe(digitString) >> maybe(exponentPart) >> ok ||
+                        "."_ch >> digitString >> maybe(exponentPart) >> ok ||
+                        digitString >> exponentPart >> ok) >>
                 construct<RealLiteralConstant::Real>()),
             maybe(underscore >> kindParam)))
 
@@ -655,7 +654,7 @@ TYPE_PARSER(construct<LengthSelector>(
 
 // R723 char-length -> ( type-param-value ) | digit-string
 TYPE_PARSER(construct<CharLength>(parenthesized(typeParamValue)) ||
-    construct<CharLength>(space >> digitString / spaceCheck))
+    construct<CharLength>(space >> digitString64 / spaceCheck))
 
 // R724 char-literal-constant ->
 //        [kind-param _] ' [rep-char]... ' |

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index 2e69993..003126b 100644 (file)
--- a/flang/lib/parser/parse-tree.h
+++ b/flang/lib/parser/parse-tree.h
@@ -735,13 +735,13 @@ struct KindParam {
 struct SignedIntLiteralConstant {
   TUPLE_CLASS_BOILERPLATE(SignedIntLiteralConstant);
   CharBlock source;
-  std::tuple<std::int64_t, std::optional<KindParam>> t;
+  std::tuple<CharBlock, std::optional<KindParam>> t;
 };
 
 // R708 int-literal-constant -> digit-string [_ kind-param]
 struct IntLiteralConstant {
   TUPLE_CLASS_BOILERPLATE(IntLiteralConstant);
-  std::tuple<std::uint64_t, std::optional<KindParam>> t;
+  std::tuple<CharBlock, std::optional<KindParam>> t;
 };
 
 // R712 sign -> + | -

diff --git a/flang/lib/parser/stmt-parser.h b/flang/lib/parser/stmt-parser.h
index 34a1506..15c7821 100644 (file)
--- a/flang/lib/parser/stmt-parser.h
+++ b/flang/lib/parser/stmt-parser.h
@@ -27,7 +27,7 @@ namespace Fortran::parser {
 // end-of-statement markers.
 
 // R611 label -> digit [digit]...
-constexpr auto label{space >> digitString / spaceCheck};
+constexpr auto label{space >> digitString64 / spaceCheck};
 
 template<typename PA> inline constexpr auto unterminatedStatement(const PA &p) {
   return skipStuffBeforeStatement >>

diff --git a/flang/lib/parser/token-parsers.h b/flang/lib/parser/token-parsers.h
index 2a34760..9a426ad 100644 (file)
--- a/flang/lib/parser/token-parsers.h
+++ b/flang/lib/parser/token-parsers.h
@@ -377,6 +377,40 @@ struct BOZLiteral {
 // R711 digit-string -> digit [digit]...
 // N.B. not a token -- no space is skipped
 constexpr struct DigitString {
+  using resultType = CharBlock;
+  static std::optional<resultType> Parse(ParseState &state) {
+    if (std::optional<const char *> ch1{state.PeekAtNextChar()}) {
+      if (IsDecimalDigit(**ch1)) {
+        state.UncheckedAdvance();
+        while (std::optional<const char *> p{state.PeekAtNextChar()}) {
+          if (!IsDecimalDigit(**p)) {
+            break;
+          }
+          state.UncheckedAdvance();
+        }
+        return CharBlock{*ch1, state.GetLocation()};
+      }
+    }
+    return std::nullopt;
+  }
+} digitString;
+
+struct SignedIntLiteralConstantWithoutKind {
+  using resultType = CharBlock;
+  static std::optional<resultType> Parse(ParseState &state) {
+    resultType result{state.GetLocation()};
+    static constexpr auto sign{maybe("+-"_ch / space)};
+    if (sign.Parse(state).has_value()) {
+      if (auto digits{digitString.Parse(state)}) {
+        result.ExtendToCover(*digits);
+        return result;
+      }
+    }
+    return std::nullopt;
+  }
+};
+
+constexpr struct DigitString64 {
   using resultType = std::uint64_t;
   static std::optional<std::uint64_t> Parse(ParseState &state) {
     std::optional<const char *> firstDigit{digit.Parse(state)};
@@ -402,26 +436,7 @@ constexpr struct DigitString {
     }
     return {value};
   }
-} digitString;
-
-constexpr struct SkipDigitString {
-  using resultType = Success;
-  static std::optional<Success> Parse(ParseState &state) {
-    if (std::optional<const char *> ch1{state.PeekAtNextChar()}) {
-      if (IsDecimalDigit(**ch1)) {
-        state.UncheckedAdvance();
-        while (std::optional<const char *> p{state.PeekAtNextChar()}) {
-          if (!IsDecimalDigit(**p)) {
-            break;
-          }
-          state.UncheckedAdvance();
-        }
-        return {Success{}};
-      }
-    }
-    return std::nullopt;
-  }
-} skipDigitString;
+} digitString64;
 
 // R707 signed-int-literal-constant -> [sign] int-literal-constant
 // N.B. Spaces are consumed before and after the sign, since the sign
@@ -444,22 +459,6 @@ static std::optional<std::int64_t> SignedInteger(
   return std::make_optional<std::int64_t>(negate ? -value : value);
 }
 
-struct SignedIntLiteralConstantWithoutKind {
-  using resultType = std::int64_t;
-  static std::optional<std::int64_t> Parse(ParseState &state) {
-    Location at{state.GetLocation()};
-    static constexpr auto minus{attempt("-"_tok)};
-    static constexpr auto plus{maybe("+"_tok)};
-    bool negate{false};
-    if (minus.Parse(state)) {
-      negate = true;
-    } else if (!plus.Parse(state).has_value()) {
-      return std::nullopt;
-    }
-    return SignedInteger(digitString.Parse(state), at, negate, state);
-  }
-};
-
 // R710 signed-digit-string -> [sign] digit-string
 // N.B. Not a complete token -- no space is skipped.
 // Used only in the exponent parts of real literal constants.
@@ -474,7 +473,7 @@ struct SignedDigitString {
     if (negate || **sign == '+') {
       state.UncheckedAdvance();
     }
-    return SignedInteger(digitString.Parse(state), *sign, negate, state);
+    return SignedInteger(digitString64.Parse(state), *sign, negate, state);
   }
 };
 

diff --git a/flang/lib/parser/unparse.cc b/flang/lib/parser/unparse.cc
index a173e5e..740615c 100644 (file)
--- a/flang/lib/parser/unparse.cc
+++ b/flang/lib/parser/unparse.cc
@@ -146,11 +146,11 @@ public:
         x.u);
   }
   void Unparse(const SignedIntLiteralConstant &x) {  // R707
-    Walk(std::get<std::int64_t>(x.t));
+    Put(std::get<CharBlock>(x.t).ToString());
     Walk("_", std::get<std::optional<KindParam>>(x.t));
   }
   void Unparse(const IntLiteralConstant &x) {  // R708
-    Walk(std::get<std::uint64_t>(x.t));
+    Put(std::get<CharBlock>(x.t).ToString());
     Walk("_", std::get<std::optional<KindParam>>(x.t));
   }
   void Unparse(const Sign &x) {  // R712

diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 558e250..2226c56 100644 (file)
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -399,17 +399,38 @@ int ExpressionAnalyzer::AnalyzeKindParam(
 }
 
 // Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
+struct IntTypeVisitor {
+  using Result = MaybeExpr;
+  using Types = IntegerTypes;
+  template<typename T> Result Test() {
+    if (T::kind == kind) {
+      const char *p{digits.begin()};
+      auto value{T::Scalar::Read(p, 10, true)};
+      if (!value.overflow) {
+        return Expr<SomeType>{
+            Expr<SomeInteger>{Expr<T>{Constant<T>{std::move(value.value)}}}};
+      }
+    }
+    return std::nullopt;
+  }
+  parser::CharBlock digits;
+  int kind;
+};
+
 template<typename PARSED>
 MaybeExpr ExpressionAnalyzer::IntLiteralConstant(const PARSED &x) {
   int kind{AnalyzeKindParam(std::get<std::optional<parser::KindParam>>(x.t),
       GetDefaultKind(TypeCategory::Integer))};
-  auto value{std::get<0>(x.t)};  // std::(u)int64_t
-  if (!CheckIntrinsicKind(TypeCategory::Integer, kind)) {
-    return std::nullopt;
+  if (CheckIntrinsicKind(TypeCategory::Integer, kind)) {
+    auto digits{std::get<parser::CharBlock>(x.t)};
+    if (MaybeExpr result{common::SearchTypes(IntTypeVisitor{digits, kind})}) {
+      return result;
+    } else {
+      Say(digits, "Integer literal too large for INTEGER(KIND=%d)"_err_en_US,
+          kind);
+    }
   }
-  return common::SearchTypes(
-      TypeKindVisitor<TypeCategory::Integer, Constant, std::int64_t>{
-          kind, static_cast<std::int64_t>(value)});
+  return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::IntLiteralConstant &x) {
@@ -587,7 +608,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
   default: CRASH_NO_CASE;
   }
   CHECK(*p == '"');
-  auto value{BOZLiteralConstant::ReadUnsigned(++p, base)};
+  ++p;
+  auto value{BOZLiteralConstant::Read(p, base, false /*unsigned*/)};
   if (*p != '"') {
     Say("invalid digit ('%c') in BOZ literal %s"_err_en_US, *p, x.v.data());
     return std::nullopt;

diff --git a/flang/test/evaluate/integer.cc b/flang/test/evaluate/integer.cc
index c6a5574..0c827f1 100644 (file)
--- a/flang/test/evaluate/integer.cc
+++ b/flang/test/evaluate/integer.cc
@@ -48,25 +48,25 @@ template<int BITS, typename INT = Integer<BITS>> void exhaustiveTesting() {
     char buffer[64];
     std::snprintf(buffer, sizeof buffer, "   %llu", ullx);
     const char *p{buffer};
-    auto readcheck{INT::ReadUnsigned(p)};
+    auto readcheck{INT::Read(p)};
     TEST(!readcheck.overflow)("%s, x=0x%llx", desc, x);
     MATCH(x, readcheck.value.ToUInt64())("%s, x=0x%llx", desc, x);
     TEST(!*p)("%s, x=0x%llx", desc, x);
     std::snprintf(buffer, sizeof buffer, "%llx", ullx);
     p = buffer;
-    readcheck = INT::ReadUnsigned(p, 16);
+    readcheck = INT::Read(p, 16);
     TEST(!readcheck.overflow)("%s, x=0x%llx", desc, x);
     MATCH(x, readcheck.value.ToUInt64())("%s, x=0x%llx", desc, x);
     TEST(!*p)("%s, x=0x%llx", desc, x);
     std::string udec{a.UnsignedDecimal()};
     p = udec.data();
-    readcheck = INT::ReadUnsigned(p);
+    readcheck = INT::Read(p);
     TEST(!readcheck.overflow)("%s, x=0x%llx", desc, x);
     MATCH(x, readcheck.value.ToUInt64())("%s, x=0x%llx", desc, x);
     TEST(!*p)("%s, x=0x%llx", desc, x);
     std::string hex{a.Hexadecimal()};
     p = hex.data();
-    readcheck = INT::ReadUnsigned(p, 16);
+    readcheck = INT::Read(p, 16);
     TEST(!readcheck.overflow)("%s, x=0x%llx", desc, x);
     MATCH(x, readcheck.value.ToUInt64())("%s, x=0x%llx", desc, x);
     TEST(!*p)("%s, x=0x%llx", desc, x);

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index c32e5a2..932421a 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -25,6 +25,7 @@ set(ERROR_TESTS
   implicit06.f90
   implicit07.f90
   implicit08.f90
+  int-literals.f90
   kinds02.f90
   resolve01.f90
   resolve02.f90

diff --git a/flang/test/semantics/int-literals.f90 b/flang/test/semantics/int-literals.f90
new file mode 100644 (file)
index 0000000..1f71909
--- /dev/null
+++ b/flang/test/semantics/int-literals.f90
@@ -0,0 +1,66 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! Fortran syntax considers signed int literals in complex literals
+! to be a distinct production, not an application of unary +/- to
+! an unsigned int literal, so they're used here to test overflow
+! on signed int literal constants.  The literals are tested here
+! as part of expressions that name resolution must analyze.
+
+complex, parameter :: okj1 = 127_1, okz1 = (+127_1, -128_1)
+!ERROR: Integer literal too large for INTEGER(KIND=1)
+complex, parameter :: badj1 = 128_1
+!ERROR: Integer literal too large for INTEGER(KIND=1)
+complex, parameter :: badz1 = (+128_1, 0)
+complex, parameter :: okj1a = 128_2
+complex, parameter :: okz1a = (+128_2, 0)
+
+complex, parameter :: okj2 = 32767_2, okz2 = (+32767_2, -32768_2)
+!ERROR: Integer literal too large for INTEGER(KIND=2)
+complex, parameter :: badj2 = 32768_2
+!ERROR: Integer literal too large for INTEGER(KIND=2)
+complex, parameter :: badz2 = (+32768_2, 0)
+complex, parameter :: okj2a = 32768_4
+complex, parameter :: okz2a = (+32768_4, 0)
+
+complex, parameter :: okj4 = 2147483647_4, okz4 = (+2147483647_4, -2147483648_4)
+!ERROR: Integer literal too large for INTEGER(KIND=4)
+complex, parameter :: badj4 = 2147483648_4
+!ERROR: Integer literal too large for INTEGER(KIND=4)
+complex, parameter :: badz4 = (+2147483648_4, 0)
+complex, parameter :: okj4a = 2147483648_8
+complex, parameter :: okz4a = (+2147483648_8, 0)
+
+complex, parameter :: okj4d = 2147483647, okz4d = (+2147483647, -2147483648)
+!ERROR: Integer literal too large for INTEGER(KIND=4)
+complex, parameter :: badj4d = 2147483648
+!ERROR: Integer literal too large for INTEGER(KIND=4)
+complex, parameter :: badz4d = (+2147483648, 0)
+
+complex, parameter :: okj8 = 9223372036854775807_8, okz8 = (+9223372036854775807_8, -9223372036854775808_8)
+!ERROR: Integer literal too large for INTEGER(KIND=8)
+complex, parameter :: badj8 = 9223372036854775808_8
+!ERROR: Integer literal too large for INTEGER(KIND=8)
+complex, parameter :: badz8 = (+9223372036854775808_8, 0)
+complex, parameter :: okj8a = 9223372036854775808_16
+complex, parameter :: okz8a = (+9223372036854775808_16, 0)
+
+complex, parameter :: okj16 = 170141183460469231731687303715884105727_16
+complex, parameter :: okz16 = (+170141183460469231731687303715884105727_16, -170141183460469231731687303715884105728_16)
+!ERROR: Integer literal too large for INTEGER(KIND=16)
+complex, parameter :: badj16 = 170141183460469231731687303715884105728_16
+!ERROR: Integer literal too large for INTEGER(KIND=16)
+complex, parameter :: badz16 = (+170141183460469231731687303715884105728_16, 0)
+
+end