From 796d5a09cb31f1dbcdb021febfac8bc5fd112c21 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 13 Nov 2017 06:07:50 +0100
Subject: tables: handle larger tables (use unsigned type instead of natural).

---
 src/dyn_tables.adb | 40 ++++++++++++++++++++++++++++++++--------
 src/dyn_tables.ads |  9 +++++++--
 src/tables.adb     |  4 +---
 3 files changed, 40 insertions(+), 13 deletions(-)

(limited to 'src')

diff --git a/src/dyn_tables.adb b/src/dyn_tables.adb
index be733acc8..9af097702 100644
--- a/src/dyn_tables.adb
+++ b/src/dyn_tables.adb
@@ -26,18 +26,25 @@ package body Dyn_Tables is
 
    --  Expand the table by doubling its size.  The table must have been
    --  initialized.
-   procedure Expand (T : in out Instance; Num : Natural)
+   procedure Expand (T : in out Instance; Num : Unsigned)
    is
       --  For efficiency, directly call realloc.
       function Crealloc (Ptr : Table_Thin_Ptr; Size : size_t)
                         return Table_Thin_Ptr;
       pragma Import (C, Crealloc, "realloc");
+
+      New_Len : Unsigned;
+      New_Last : Unsigned;
    begin
       pragma Assert (T.Priv.Length /= 0);
       pragma Assert (T.Table /= null);
 
       --  Expand the bound.
-      T.Priv.Last_Pos := T.Priv.Last_Pos + Num;
+      New_Last := T.Priv.Last_Pos + Num;
+      if New_Last < T.Priv.Last_Pos then
+         raise Constraint_Error;
+      end if;
+      T.Priv.Last_Pos := New_Last;
 
       --  Check if need to reallocate.
       if T.Priv.Last_Pos < T.Priv.Length then
@@ -45,12 +52,22 @@ package body Dyn_Tables is
       else
          --  Double the length.
          loop
-            T.Priv.Length := T.Priv.Length * 2;
-            exit when T.Priv.Length > T.Priv.Last_Pos;
+            New_Len := T.Priv.Length * 2;
+
+            --  Check overflow.
+            if New_Len < T.Priv.Length then
+               raise Constraint_Error;
+            end if;
+
+            T.Priv.Length := New_Len;
+            exit when New_Len > T.Priv.Last_Pos;
          end loop;
       end if;
 
       --  Realloc and check result.
+      if size_t (T.Priv.Length) > size_t'Last / El_Size then
+         raise Constraint_Error;
+      end if;
       T.Table := Crealloc (T.Table, size_t (T.Priv.Length) * El_Size);
       if T.Table = null then
          raise Storage_Error;
@@ -59,7 +76,7 @@ package body Dyn_Tables is
 
    procedure Allocate (T : in out Instance; Num : Natural := 1) is
    begin
-      Expand (T, Num);
+      Expand (T, Unsigned (Num));
    end Allocate;
 
    procedure Increment_Last (T : in out Instance) is
@@ -75,7 +92,7 @@ package body Dyn_Tables is
 
    procedure Set_Last (T : in out Instance; Index : Table_Index_Type)
    is
-      New_Last : constant Natural :=
+      New_Last : constant Unsigned :=
         (Table_Index_Type'Pos (Index)
            - Table_Index_Type'Pos (Table_Low_Bound) + 1);
    begin
@@ -96,7 +113,7 @@ package body Dyn_Tables is
    begin
       if T.Table = null then
          --  Allocate memory if not already allocated.
-         T.Priv.Length := Table_Initial;
+         T.Priv.Length := Unsigned (Table_Initial);
          T.Table := Cmalloc (size_t (T.Priv.Length) * El_Size);
       end if;
 
@@ -107,9 +124,16 @@ package body Dyn_Tables is
    function Last (T : Instance) return Table_Index_Type is
    begin
       return Table_Index_Type'Val
-        (Table_Index_Type'Pos (Table_Low_Bound) + T.Priv.Last_Pos - 1);
+        (Table_Index_Type'Pos (Table_Low_Bound)
+           + Unsigned'Pos (T.Priv.Last_Pos) - 1);
    end Last;
 
+   function Next (T : Instance) return Table_Index_Type is
+   begin
+      return Table_Index_Type'Val
+        (Table_Index_Type'Pos (Table_Low_Bound) + T.Priv.Last_Pos);
+   end Next;
+
    procedure Free (T : in out Instance) is
       --  Direct interface to free.
       procedure Cfree (Ptr : Table_Thin_Ptr);
diff --git a/src/dyn_tables.ads b/src/dyn_tables.ads
index 600e2bf85..f1cffac84 100644
--- a/src/dyn_tables.ads
+++ b/src/dyn_tables.ads
@@ -71,6 +71,9 @@ package Dyn_Tables is
    function Last (T : Instance) return Table_Index_Type;
    pragma Inline (Last);
 
+   --  Return the index of the next bound after last.
+   function Next (T : Instance) return Table_Index_Type;
+
    --  Deallocate all the memory.  Makes the array unusable until the next
    --  call to Init.
    procedure Free (T : in out Instance);
@@ -95,11 +98,13 @@ package Dyn_Tables is
    procedure Allocate (T : in out Instance; Num : Natural := 1);
 
 private
+   type Unsigned is mod 2**32;
+
    type Instance_Private is record
       --  Number of allocated elements in the table.
-      Length : Natural := 0;
+      Length : Unsigned := 0;
 
       --  Number of used elements in the table.
-      Last_Pos : Natural := 0;
+      Last_Pos : Unsigned := 0;
    end record;
 end Dyn_Tables;
diff --git a/src/tables.adb b/src/tables.adb
index ef4cc385a..3b8a888b8 100644
--- a/src/tables.adb
+++ b/src/tables.adb
@@ -19,8 +19,7 @@
 package body Tables is
    function Allocate (Num : Natural := 1) return Table_Index_Type
    is
-      Res : constant Table_Index_Type := Table_Index_Type'Val
-        (Table_Index_Type'Pos (Last) + 1);
+      Res : constant Table_Index_Type := Dyn_Table.Next (T);
    begin
       Dyn_Table.Allocate (T, Num);
 
@@ -62,7 +61,6 @@ package body Tables is
    begin
       Dyn_Table.Append (T, Val);
    end Append;
-
 begin
    Init;
 end Tables;
-- 
cgit v1.2.3