[RFC][PATCH] pkl, testsuite: Improve detection of overflow in integer literals

[Mohammad-Reza Nabipoor]

With this commit the following integer literals are invalid:

  8N, 128B, 32768H, 2147483648, 9223372036854775808L

But to keep -8N, -128B, -32768H, -2147483648, -9223372036854775808L
valid literals, we have to consider minus sign as part of the integer
literal.  As a consequence, `1-2' is no longer a valid expression.
Instead, one has to write `1- 2'.

2022-08-08  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * libpoke/pkl-lex.l (pkl_lex_get_base): Add new param `negative_p'.
        (integer_literal_overflow_p): New function for overflow check.
        (Alien token rule): Use `integer_literal_overflow_p'.
        (Offset literal rule): Adapt `pkl_lex_get_base' invocation.
        (Integer literal rule): Add optional sign recognition at the
        beginning and update integer literal overflow detection logic.
        * testsuite/poke.pkl/array-integ-33.pk: Adapt to new semantics.
        * testsuite/poke.pkl/arrays-diag-3.pk: Likewise.
        * testsuite/poke.pkl/cdiv-integers-overflow-1.pk: Likewise.
        * testsuite/poke.pkl/cdiv-integers-overflow-diag-2.pk: Likewise.
        * testsuite/poke.pkl/div-integers-overflow-1.pk: Likewise.
        * testsuite/poke.pkl/div-integers-overflow-diag-2.pk: Likewise.
        * testsuite/poke.pkl/getenv-1.pk: Likewise.
        * testsuite/poke.pkl/mod-integers-overflow-1.pk: Likewise.
        * testsuite/poke.pkl/mod-integers-overflow-diag-2.pk: Likewise.
        * testsuite/poke.pkl/neg-int-overflow-1.pk: Likewise.
        * testsuite/poke.pkl/neg-int-overflow-diag-1.pk: Likewise.
        * testsuite/poke.pkl/promo-array-arg-4.pk: Likewise.
        * testsuite/poke.pkl/promo-array-arg-5.pk: Likewise.
        * testsuite/poke.pkl/promo-array-return-5.pk: Likewise.
        * testsuite/poke.pkl/sub-integers-overflow-1.pk: Likewise.
---

Hello Jose.

With this patch, nobody can write nonsenses like 666B, but OTOH we
have to force people (including you :D) to put spaces around the binary
minus operator.

Is this a good trade-off?


Regards,
Mohammad-Reza


 ChangeLog                                     |  24 ++++
 libpoke/pkl-lex.l                             | 120 +++++++++---------
 testsuite/poke.pkl/array-integ-33.pk          |   4 +-
 testsuite/poke.pkl/arrays-diag-3.pk           |   2 +-
 .../poke.pkl/cdiv-integers-overflow-1.pk      |   2 +-
 .../poke.pkl/cdiv-integers-overflow-diag-2.pk |   2 +-
 testsuite/poke.pkl/div-integers-overflow-1.pk |   2 +-
 .../poke.pkl/div-integers-overflow-diag-2.pk  |   2 +-
 testsuite/poke.pkl/getenv-1.pk                |   2 +-
 testsuite/poke.pkl/mod-integers-overflow-1.pk |   2 +-
 .../poke.pkl/mod-integers-overflow-diag-2.pk  |   2 +-
 testsuite/poke.pkl/neg-int-overflow-1.pk      |   2 +-
 testsuite/poke.pkl/neg-int-overflow-diag-1.pk |   2 +-
 testsuite/poke.pkl/promo-array-arg-4.pk       |   4 +-
 testsuite/poke.pkl/promo-array-arg-5.pk       |   4 +-
 testsuite/poke.pkl/promo-array-return-5.pk    |   4 +-
 testsuite/poke.pkl/sub-integers-overflow-1.pk |   2 +-
 17 files changed, 103 insertions(+), 79 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ef9187f5..85a97378 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2022-08-08  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * libpoke/pkl-lex.l (pkl_lex_get_base): Add new param `negative_p'.
+       (integer_literal_overflow_p): New function for overflow check.
+       (Alien token rule): Use `integer_literal_overflow_p'.
+       (Offset literal rule): Adapt `pkl_lex_get_base' invocation.
+       (Integer literal rule): Add optional sign recognition at the
+       beginning and update integer literal overflow detection logic.
+       * testsuite/poke.pkl/array-integ-33.pk: Adapt to new semantics.
+       * testsuite/poke.pkl/arrays-diag-3.pk: Likewise.
+       * testsuite/poke.pkl/cdiv-integers-overflow-1.pk: Likewise.
+       * testsuite/poke.pkl/cdiv-integers-overflow-diag-2.pk: Likewise.
+       * testsuite/poke.pkl/div-integers-overflow-1.pk: Likewise.
+       * testsuite/poke.pkl/div-integers-overflow-diag-2.pk: Likewise.
+       * testsuite/poke.pkl/getenv-1.pk: Likewise.
+       * testsuite/poke.pkl/mod-integers-overflow-1.pk: Likewise.
+       * testsuite/poke.pkl/mod-integers-overflow-diag-2.pk: Likewise.
+       * testsuite/poke.pkl/neg-int-overflow-1.pk: Likewise.
+       * testsuite/poke.pkl/neg-int-overflow-diag-1.pk: Likewise.
+       * testsuite/poke.pkl/promo-array-arg-4.pk: Likewise.
+       * testsuite/poke.pkl/promo-array-arg-5.pk: Likewise.
+       * testsuite/poke.pkl/promo-array-return-5.pk: Likewise.
+       * testsuite/poke.pkl/sub-integers-overflow-1.pk: Likewise.
+
 2022-07-25  Jose E. Marchesi  <jemarch@gnu.org>
 
        * configure.ac: Bump version to 2.4.
diff --git a/libpoke/pkl-lex.l b/libpoke/pkl-lex.l
index 78f1ce1d..583b21be 100644
--- a/libpoke/pkl-lex.l
+++ b/libpoke/pkl-lex.l
@@ -101,14 +101,16 @@
 
 /* Note that the following function assumes that STR is a pointer of a
    string that satisfies the regexp
-   ({HEXCST}|{BINCST}|{OCTCST}|{DECCST}) */
+   "-"?({HEXCST}|{BINCST}|{OCTCST}|{DECCST}) */
 
 int
-pkl_lex_get_base  (const char *str, int *offset)
+pkl_lex_get_base  (const char *str, int *offset, int *negative_p)
 {
  int base = 10;
  *offset = 0;
 
+ if ((*negative_p = str[0] == '-'))
+   str++;
  if (str[0] == '0')
   {
     if (str[1] == 'x' || str[1] == 'X')
@@ -128,7 +130,51 @@ pkl_lex_get_base  (const char *str, int *offset)
     }
   }
 
- return base;
+  *offset += *negative_p;
+  return base;
+}
+
+static int
+integer_literal_overflow_p (uint64_t value, int signed_p, int negative_p,
+                            int *width)
+{
+  /* If the width is not already known (e.g., based on the suffix),
+     the type of the integer constant is the smallest signed or unsigned
+     integer capable of holding it, starting with 32 bits, in steps of
+     power of two and up to 64 bits.  But note these are positive values!  */
+
+  if (*width == 0)
+    {
+      if (value > 0x0000000080000000 && value <= 0x00000000ffffffff)
+        *width = signed_p ? 64 : 32;
+      else if (value & 0xffffffff00000000)
+        *width = 64;
+      else
+        *width = 32;
+    }
+
+  if (*width != 64)
+    {
+      uint64_t mask = 1;
+
+      mask <<= *width;
+      mask -= 1;
+      if (value & ~mask)
+        return 1;
+    }
+
+  /* Handle overflow in signed integers.  */
+  if (signed_p)
+    {
+      uint64_t limit = (uint64_t)1 << (*width - 1);
+
+      if (negative_p && value > limit)
+        return 1;
+      if (!negative_p && value >= limit)
+        return 1;
+    }
+
+  return 0;
 }
 
 %}
@@ -438,23 +484,8 @@ S ::
             int width = token->value.integer.width;
             pkl_ast_node type;
 
-            /* As with regular integer tokens, the type of the integer
-               constant is the smallest signed or unsigned integer
-               capable of holding it, starting with 32 bits, in steps
-               of power of two and up to 64 bits. */
-
-            if (width == 0)
-              {
-                if (value > 0x0000000080000000 && value <= 0x00000000ffffffff)
-                  width = signed_p ? 64 : 32;
-                else if (value & 0xffffffff00000000)
-                  width = 64;
-                else
-                  width = 32;
-              }
-
-            /* Handle overflow in signed integers. */
-            if (signed_p && value >= 0x8000000000000000)
+            if (integer_literal_overflow_p (value, signed_p,
+                                            /*negative_p (dummy)*/ 1, &width))
               return INTEGER_OVERFLOW;
 
             type = pkl_ast_make_integral_type (yyextra->ast, width, signed_p);
@@ -472,23 +503,8 @@ S ::
             int width = token->value.offset.width;
             pkl_ast_node unit, magnitude, magnitude_type, offset_type, 
unit_type;
 
-            /* As with regular integer tokens, the type of the integer
-               constant is the smallest signed or unsigned integer
-               capable of holding it, starting with 32 bits, in steps
-               of power of two and up to 64 bits. */
-
-            if (width == 0)
-              {
-                if (value > 0x0000000080000000 && value <= 0x00000000ffffffff)
-                  width = signed_p ? 64 : 32;
-                else if (value & 0xffffffff00000000)
-                  width = 64;
-                else
-                  width = 32;
-              }
-
-            /* Handle overflow in signed integers. */
-            if (signed_p && value >= 0x8000000000000000)
+            if (integer_literal_overflow_p (value, signed_p,
+                                            /*negative_p (dummy)*/ 1, &width))
               return INTEGER_OVERFLOW;
 
             /* Build the offset magnitude.  */
@@ -530,12 +546,12 @@ S ::
 
 #({HEXCST}|{BINCST}|{OCTCST}|{DECCST}) {
   char *end;
-  int base, offset;
+  int base, offset, negative_p;
   uint64_t value;
   pkl_ast_node type
      = pkl_ast_make_integral_type (yyextra->ast, 64, 0);
 
-  base = pkl_lex_get_base (yytext + 1, &offset);
+  base = pkl_lex_get_base (yytext + 1, &offset, &negative_p);
   value = strtoll (yytext + 1 + offset, &end, base);
   yylval->ast = pkl_ast_make_integer (yyextra->ast, value);
   PKL_AST_TYPE (yylval->ast) = ASTREF (type);
@@ -577,9 +593,9 @@ S ::
      return IDENTIFIER;
 }
 
-({HEXCST}|{BINCST}|{OCTCST}|{DECCST}){IS}? {
+"-"?({HEXCST}|{BINCST}|{OCTCST}|{DECCST}){IS}? {
   uint64_t value;
-  int base, offset, signed_p, width;
+  int base, offset, signed_p, width, negative_p;
   char *p, *end;
   pkl_ast_node type;
 
@@ -593,7 +609,7 @@ S ::
        *tmp = *(tmp + 1);
   }
 
-  base = pkl_lex_get_base (yytext, &offset);
+  base = pkl_lex_get_base (yytext, &offset, &negative_p);
 
   /* strtoull can fail here only in case of overflow.  */
   errno = 0;
@@ -619,28 +635,12 @@ S ::
       || ((*end != '\0') && ((*(end + 1) == 'n' || *(end + 1) == 'N'))))
     width = 4;
 
-  /* If not specified with the 'l' or 'L' suffix, the type of the
-     integer constant is the smallest signed or unsigned integer
-     capable of holding it, starting with 32 bits, in steps of power
-     of two and up to 64 bits.  But note these are positive values! */
-
-  if (width == 0)
-  {
-    if (value > 0x0000000080000000 && value <= 0x00000000ffffffff)
-      width = signed_p ? 64 : 32;
-    else if (value & 0xffffffff00000000)
-      width = 64;
-    else
-      width = 32;
-  }
-
-  /* Handle overflow in signed integers. */
-  if (signed_p && value >= 0x8000000000000000)
+  if (integer_literal_overflow_p (value, signed_p, negative_p, &width))
     return INTEGER_OVERFLOW;
 
   type = pkl_ast_make_integral_type (yyextra->ast, width, signed_p);
 
-  yylval->ast = pkl_ast_make_integer (yyextra->ast, value);
+  yylval->ast = pkl_ast_make_integer (yyextra->ast, negative_p ? -value : 
value);
   PKL_AST_TYPE (yylval->ast) = ASTREF (type);
 
   return INTEGER;
diff --git a/testsuite/poke.pkl/array-integ-33.pk 
b/testsuite/poke.pkl/array-integ-33.pk
index 3db905ea..6481063c 100644
--- a/testsuite/poke.pkl/array-integ-33.pk
+++ b/testsuite/poke.pkl/array-integ-33.pk
@@ -1,9 +1,9 @@
 /* { dg-do run } */
 
-var a = [[[[[[[[0xdeadH,0xbeefH]]]]]]]];
+var a = [[[[[[[[0xdeadUH,0xbeefUH]]]]]]]];
 
 /* { dg-command {.set obase 16} } */
 /* { dg-command {a as int<32>} } */
 /* { dg-output {0xdeadbeef\n} } */
-/* { dg-command {[[[[[[[[0xdeadH,0xbeefH]]]]]]]] as int<32>} } */
+/* { dg-command {[[[[[[[[0xdeadUH,0xbeefUH]]]]]]]] as int<32>} } */
 /* { dg-output {0xdeadbeef} } */
diff --git a/testsuite/poke.pkl/arrays-diag-3.pk 
b/testsuite/poke.pkl/arrays-diag-3.pk
index 8e16b95b..90d5adc1 100644
--- a/testsuite/poke.pkl/arrays-diag-3.pk
+++ b/testsuite/poke.pkl/arrays-diag-3.pk
@@ -1,3 +1,3 @@
 /* { dg-do compile } */
 
-var a = [0,1,.[1-2]=10]; /* { dg-error "negative" } */
+var a = [0,1,.[1 - 2]=10]; /* { dg-error "negative" } */
diff --git a/testsuite/poke.pkl/cdiv-integers-overflow-1.pk 
b/testsuite/poke.pkl/cdiv-integers-overflow-1.pk
index 327db6b0..44b1b8bc 100644
--- a/testsuite/poke.pkl/cdiv-integers-overflow-1.pk
+++ b/testsuite/poke.pkl/cdiv-integers-overflow-1.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-var x = 0x8000_0000;
+var x = -0x8000_0000;
 
 /* { dg-command {  try x /^ -1; catch if E_overflow { print "caught\n"; } } } 
*/
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/cdiv-integers-overflow-diag-2.pk 
b/testsuite/poke.pkl/cdiv-integers-overflow-diag-2.pk
index d2e2472e..d4060568 100644
--- a/testsuite/poke.pkl/cdiv-integers-overflow-diag-2.pk
+++ b/testsuite/poke.pkl/cdiv-integers-overflow-diag-2.pk
@@ -1,4 +1,4 @@
 /* { dg-do compile } */
 
 var res
-  = 0x8000_0000 /^ -1; /* { dg-error "overflow" } */
+  = -0x8000_0000 /^ -1; /* { dg-error "overflow" } */
diff --git a/testsuite/poke.pkl/div-integers-overflow-1.pk 
b/testsuite/poke.pkl/div-integers-overflow-1.pk
index 23fc279c..ba051e6a 100644
--- a/testsuite/poke.pkl/div-integers-overflow-1.pk
+++ b/testsuite/poke.pkl/div-integers-overflow-1.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-var x = 0x8000_0000;
+var x = -0x8000_0000;
 
 /* { dg-command {  try x / -1; catch if E_overflow { print "caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/div-integers-overflow-diag-2.pk 
b/testsuite/poke.pkl/div-integers-overflow-diag-2.pk
index e530daa8..50397b95 100644
--- a/testsuite/poke.pkl/div-integers-overflow-diag-2.pk
+++ b/testsuite/poke.pkl/div-integers-overflow-diag-2.pk
@@ -1,4 +1,4 @@
 /* { dg-do compile } */
 
 var res
-  = 0x8000_0000 / -1; /* { dg-error "overflow" } */
+  = -0x8000_0000 / -1; /* { dg-error "overflow" } */
diff --git a/testsuite/poke.pkl/getenv-1.pk b/testsuite/poke.pkl/getenv-1.pk
index 4c81f209..13d3de72 100644
--- a/testsuite/poke.pkl/getenv-1.pk
+++ b/testsuite/poke.pkl/getenv-1.pk
@@ -6,5 +6,5 @@
 var picklesdir = getenv ("POKEPICKLESDIR");
 var length = picklesdir'length;
 
-/* { dg-command { picklesdir[length-8:length] } } */
+/* { dg-command { picklesdir[length - 8:length] } } */
 /* { dg-output {"/pickles"} } */
diff --git a/testsuite/poke.pkl/mod-integers-overflow-1.pk 
b/testsuite/poke.pkl/mod-integers-overflow-1.pk
index 9452b5d6..bcdf53b5 100644
--- a/testsuite/poke.pkl/mod-integers-overflow-1.pk
+++ b/testsuite/poke.pkl/mod-integers-overflow-1.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-var x = 0x8000_0000;
+var x = -0x8000_0000;
 
 /* { dg-command {  try x % -1; catch if E_overflow { print "caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/mod-integers-overflow-diag-2.pk 
b/testsuite/poke.pkl/mod-integers-overflow-diag-2.pk
index 15277be3..0ebd9c91 100644
--- a/testsuite/poke.pkl/mod-integers-overflow-diag-2.pk
+++ b/testsuite/poke.pkl/mod-integers-overflow-diag-2.pk
@@ -1,4 +1,4 @@
 /* { dg-do compile } */
 
 var res
-  = 0x8000_0000 % -1; /* { dg-error "overflow" } */
+  = -0x8000_0000 % -1; /* { dg-error "overflow" } */
diff --git a/testsuite/poke.pkl/neg-int-overflow-1.pk 
b/testsuite/poke.pkl/neg-int-overflow-1.pk
index 52fad876..8d769b61 100644
--- a/testsuite/poke.pkl/neg-int-overflow-1.pk
+++ b/testsuite/poke.pkl/neg-int-overflow-1.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-var x = 0x8000_0000;
+var x = -0x8000_0000;
 
 /* { dg-command {  try -x; catch if E_overflow { print "caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/neg-int-overflow-diag-1.pk 
b/testsuite/poke.pkl/neg-int-overflow-diag-1.pk
index 8e152221..76074eab 100644
--- a/testsuite/poke.pkl/neg-int-overflow-diag-1.pk
+++ b/testsuite/poke.pkl/neg-int-overflow-diag-1.pk
@@ -1,4 +1,4 @@
 /* { dg-do compile } */
 
 var res
-  = -0x8000_0000; /* { dg-error "overflow" } */
+  = 0 - -0x8000_0000; /* { dg-error "overflow" } */
diff --git a/testsuite/poke.pkl/promo-array-arg-4.pk 
b/testsuite/poke.pkl/promo-array-arg-4.pk
index 23b8eeda..94dc2b85 100644
--- a/testsuite/poke.pkl/promo-array-arg-4.pk
+++ b/testsuite/poke.pkl/promo-array-arg-4.pk
@@ -1,8 +1,8 @@
 /* { dg-do run } */
 
 var x = 3;
-fun foo = (int[x-1] a) int: { return a[1]; }
-fun bar = (int[x-1][x-1] a) int: { return a[1][1]; }
+fun foo = (int[x - 1] a) int: { return a[1]; }
+fun bar = (int[x - 1][x - 1] a) int: { return a[1][1]; }
 
 /* { dg-command { foo ([1,2]) } } */
 /* { dg-output "2" } */
diff --git a/testsuite/poke.pkl/promo-array-arg-5.pk 
b/testsuite/poke.pkl/promo-array-arg-5.pk
index a4864328..1f29de4f 100644
--- a/testsuite/poke.pkl/promo-array-arg-5.pk
+++ b/testsuite/poke.pkl/promo-array-arg-5.pk
@@ -1,8 +1,8 @@
 /* { dg-do run } */
 
 var x = 3;
-fun foo = (int[x-1] a) int: { return a[1]; }
-fun bar = (int[x-1][x-1] a) int: { return a[1][1]; }
+fun foo = (int[x - 1] a) int: { return a[1]; }
+fun bar = (int[x - 1][x - 1] a) int: { return a[1][1]; }
 
 /* { dg-command { foo ([1,2] as int[]) } } */
 /* { dg-output "2" } */
diff --git a/testsuite/poke.pkl/promo-array-return-5.pk 
b/testsuite/poke.pkl/promo-array-return-5.pk
index 354fad4f..021497a7 100644
--- a/testsuite/poke.pkl/promo-array-return-5.pk
+++ b/testsuite/poke.pkl/promo-array-return-5.pk
@@ -1,8 +1,8 @@
 /* { dg-do run } */
 
 var x = 3;
-fun foo = int[x-1]: { return [1,2]; }
-fun bar = int[x-1][x-1]: { return [[1,2],[3,4]]; }
+fun foo = int[x - 1]: { return [1,2]; }
+fun bar = int[x - 1][x - 1]: { return [[1,2],[3,4]]; }
 
 /* { dg-command {foo[1]} } */
 /* { dg-output "2" } */
diff --git a/testsuite/poke.pkl/sub-integers-overflow-1.pk 
b/testsuite/poke.pkl/sub-integers-overflow-1.pk
index 3929cf0f..88be7988 100644
--- a/testsuite/poke.pkl/sub-integers-overflow-1.pk
+++ b/testsuite/poke.pkl/sub-integers-overflow-1.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-var x = 0x8000_0000 as int<32>;
+var x = 0x8000_0000U as int<32>;
 
 /* { dg-command {  try x - 1; catch if E_overflow { print "caught\n"; } } } */
 /* { dg-output "caught" } */
-- 
2.37.1