2007-08-14 Thomas Quinot <quinot@adacore.com>

	* table.adb, g-table.adb, g-dyntab.adb (Append): Reimplement in terms
	of Set_Item.
	(Set_Item): When the new item is an element of the currently allocated
	table passed by reference, save a copy on the stack if we're going
	to reallocate. Also, in Table.Set_Item, make sure we test the proper
	variable to determine whether to call Set_Last.

	* sinput-d.adb, sinput-l.adb, stringt.adb, switch-m.adb,
	symbols-vms.adb, symbols-processing-vms-alpha.adb,
	symbols-processing-vms-ia64.adb, sem_elab.adb, repinfo.adb: Replace
	some occurrences of the pattern
	   T.Increment_Last;
	   T.Table (T.Last) := Value;
	with a cleaner call to
	   T.Append (Value);



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127442 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 59 insertions, 8 deletions

diff --git a/gcc/ada/g-table.adb b/gcc/ada/g-table.adb
index f16b6fd1fe5..2fd5d320034 100644
--- a/gcc/ada/g-table.adb
+++ b/gcc/ada/g-table.adb
@@ -93,8 +93,7 @@ package body GNAT.Table is
 
    procedure Append (New_Val : Table_Component_Type) is
    begin
-      Increment_Last;
-      Table (Table_Index_Type (Last_Val)) := New_Val;
+      Set_Item (Table_Index_Type (Last_Val + 1), New_Val);
    end Append;
 
    --------------------
@@ -227,15 +226,67 @@ package body GNAT.Table is
    --------------
 
    procedure Set_Item
-     (Index : Table_Index_Type;
-      Item  : Table_Component_Type)
+      (Index : Table_Index_Type;
+       Item  : Table_Component_Type)
    is
+      --  If Item is a value within the current allocation, and we are going to
+      --  reallocate, then we must preserve an intermediate copy here before
+      --  calling Increment_Last. Otherwise, if Table_Component_Type is passed
+      --  by reference, we are going to end up copying from storage that might
+      --  have been deallocated from Increment_Last calling Reallocate.
+
+      subtype Allocated_Table_T is
+        Table_Type (Table'First .. Table_Index_Type (Max + 1));
+      --  A constrained table subtype one element larger than the currently
+      --  allocated table.
+
+      Allocated_Table_Address : constant System.Address :=
+                                  Table.all'Address;
+      --  Used for address clause below (we can't use non-static expression
+      --  Table.all'Address directly in the clause because some older versions
+      --  of the compiler do not allow it).
+
+      Allocated_Table : Allocated_Table_T;
+      pragma Import (Ada, Allocated_Table);
+      for Allocated_Table'Address use Allocated_Table_Address;
+      --  Allocated_Table represents the currently allocated array, plus
+      --  one element (the supplementary element is used to have a
+      --  convenient way of computing the address just past the end of the
+      --  current allocation).
+
+      Need_Realloc : constant Boolean := Integer (Index) > Max;
+      --  True if this operation requires storage reallocation (which may
+      --  involve moving table contents around).
+
    begin
-      if Integer (Index) > Last_Val then
-         Set_Last (Index);
-      end if;
+      --  If we're going to reallocate, check wheter Item references an
+      --  element of the currently allocated table.
+
+      if Need_Realloc
+        and then Allocated_Table'Address <= Item'Address
+        and then Item'Address <
+                   Allocated_Table (Table_Index_Type (Max + 1))'Address
+      then
+         --  If so, save a copy on the stack because Increment_Last will
+         --  reallocate storage and might deallocate the current table.
+
+         declare
+            Item_Copy : constant Table_Component_Type := Item;
+         begin
+            Set_Last (Index);
+            Table (Index) := Item_Copy;
+         end;
+
+      else
+         --  Here we know that either we won't reallocate (case of Index < Max)
+         --  or that Item is not in the currently allocated table.
 
-      Table (Index) := Item;
+         if Integer (Index) > Last_Val then
+            Set_Last (Index);
+         end if;
+
+         Table (Index) := Item;
+      end if;
    end Set_Item;
 
    --------------