[multiple changes]

2016-10-12  Bob Duff  <duff@adacore.com>

	* xref_lib.adb: Use renamings-of-slices to ensure
	that all references to Tables are properly bounds checked (when
	checks are turned on).
	* g-dyntab.ads, g-dyntab.adb: Default-initialize the array
	components, so we don't get uninitialized pointers in case
	of Tables containing access types.  Misc cleanup of the code
	and comments.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Type_Key): Implement
	functionality of attribute, to provide a reasonably unique key
	for a given type and detect any changes in the semantics of the
	type or any of its subcomponents from version to version.

2016-10-12  Bob Duff  <duff@adacore.com>

	* sem_case.adb (Check_Choice_Set): Separate
	checking for duplicates out into a separate pass from checking
	full coverage, because the check for duplicates does not depend
	on predicates. Therefore, we shouldn't do it separately for the
	predicate vs. no-predicate case; we should share code. The code
	for the predicate case was wrong.

From-SVN: r241039

6 files changed, 563 insertions, 362 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fd49a21..101ea652 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2016-10-12  Bob Duff  <duff@adacore.com>
+
+	* xref_lib.adb: Use renamings-of-slices to ensure
+	that all references to Tables are properly bounds checked (when
+	checks are turned on).
+	* g-dyntab.ads, g-dyntab.adb: Default-initialize the array
+	components, so we don't get uninitialized pointers in case
+	of Tables containing access types.  Misc cleanup of the code
+	and comments.
+
+2016-10-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Type_Key): Implement
+	functionality of attribute, to provide a reasonably unique key
+	for a given type and detect any changes in the semantics of the
+	type or any of its subcomponents from version to version.
+
+2016-10-12  Bob Duff  <duff@adacore.com>
+
+	* sem_case.adb (Check_Choice_Set): Separate
+	checking for duplicates out into a separate pass from checking
+	full coverage, because the check for duplicates does not depend
+	on predicates. Therefore, we shouldn't do it separately for the
+	predicate vs. no-predicate case; we should share code. The code
+	for the predicate case was wrong.
+
 2016-10-12  Jerome Lambourg  <lambourg@adacore.com>
 
 	* init.c: Make sure to call finit on x86_64-vx7 to reinitialize
diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb
index e5e41c9..a74697d 100644
--- a/gcc/ada/g-dyntab.adb
+++ b/gcc/ada/g-dyntab.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2000-2014, AdaCore                     --
+--                     Copyright (C) 2000-2016, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -32,33 +32,23 @@
 pragma Compiler_Unit_Warning;
 
 with GNAT.Heap_Sort_G;
-with System;        use System;
-with System.Memory; use System.Memory;
 
-with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
 
 package body GNAT.Dynamic_Tables is
 
-   Min : constant Integer := Integer (Table_Low_Bound);
-   --  Subscript of the minimum entry in the currently allocated table
+   Empty : constant Table_Ptr :=
+             Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access);
 
    -----------------------
    -- Local Subprograms --
    -----------------------
 
-   procedure Reallocate (T : in out Instance);
-   --  Reallocate the existing table according to the current value stored
-   --  in Max. Works correctly to do an initial allocation if the table
-   --  is currently null.
-
-   pragma Warnings (Off);
-   --  These unchecked conversions are in fact safe, since they never
-   --  generate improperly aliased pointer values.
-
-   function To_Address is new Ada.Unchecked_Conversion (Table_Ptr, Address);
-   function To_Pointer is new Ada.Unchecked_Conversion (Address, Table_Ptr);
-
-   pragma Warnings (On);
+   procedure Grow (T : in out Instance; New_Last : Table_Count_Type);
+   --  This is called when we are about to set the value of Last to a value
+   --  that is larger than Last_Allocated. This reallocates the table to the
+   --  larger size, as indicated by New_Last. At the time this is called,
+   --  T.P.Last is still the old value.
 
    --------------
    -- Allocate --
@@ -66,11 +56,9 @@ package body GNAT.Dynamic_Tables is
 
    procedure Allocate (T : in out Instance; Num : Integer := 1) is
    begin
-      T.P.Last_Val := T.P.Last_Val + Num;
+      --  Note that Num can be negative
 
-      if T.P.Last_Val > T.P.Max then
-         Reallocate (T);
-      end if;
+      Set_Last (T, T.P.Last + Table_Index_Type'Base (Num));
    end Allocate;
 
    ------------
@@ -79,7 +67,7 @@ package body GNAT.Dynamic_Tables is
 
    procedure Append (T : in out Instance; New_Val : Table_Component_Type) is
    begin
-      Set_Item (T, Table_Index_Type (T.P.Last_Val + 1), New_Val);
+      Set_Item (T, T.P.Last + 1, New_Val);
    end Append;
 
    ----------------
@@ -99,9 +87,18 @@ package body GNAT.Dynamic_Tables is
 
    procedure Decrement_Last (T : in out Instance) is
    begin
-      T.P.Last_Val := T.P.Last_Val - 1;
+      Allocate (T, -1);
    end Decrement_Last;
 
+   -----------
+   -- First --
+   -----------
+
+   function First return Table_Index_Type is
+   begin
+      return Table_Low_Bound;
+   end First;
+
    --------------
    -- For_Each --
    --------------
@@ -109,7 +106,7 @@ package body GNAT.Dynamic_Tables is
    procedure For_Each (Table : Instance) is
       Quit : Boolean := False;
    begin
-      for Index in Table_Low_Bound .. Table_Index_Type (Table.P.Last_Val) loop
+      for Index in Table_Low_Bound .. Table.P.Last loop
          Action (Index, Table.Table (Index), Quit);
          exit when Quit;
       end loop;
@@ -120,23 +117,119 @@ package body GNAT.Dynamic_Tables is
    ----------
 
    procedure Free (T : in out Instance) is
+      subtype Alloc_Type is Table_Type (First .. T.P.Last_Allocated);
+      type Alloc_Ptr is access all Alloc_Type;
+
+      procedure Free is new Ada.Unchecked_Deallocation (Alloc_Type, Alloc_Ptr);
+      function To_Alloc_Ptr is
+        new Ada.Unchecked_Conversion (Table_Ptr, Alloc_Ptr);
+
+      Temp : Alloc_Ptr := To_Alloc_Ptr (T.Table);
+
    begin
-      Free (To_Address (T.Table));
-      T.Table := null;
-      T.P.Length := 0;
+      if T.Table = Empty then
+         pragma Assert (T.P.Last_Allocated = First - 1);
+         pragma Assert (T.P.Last = First - 1);
+         null;
+      else
+         Free (Temp);
+         T.Table := Empty;
+         T.P.Last_Allocated := First - 1;
+         T.P.Last := First - 1;
+      end if;
    end Free;
 
+   ----------
+   -- Grow --
+   ----------
+
+   procedure Grow (T : in out Instance; New_Last : Table_Count_Type) is
+
+      --  Note: Type Alloc_Ptr below needs to be declared locally so we know
+      --  the bounds. That means that the collection is local, so is finalized
+      --  when leaving Grow. That's why this package doesn't support controlled
+      --  types; the table elements would be finalized prematurely. An Ada
+      --  implementation would also be within its rights to reclaim the
+      --  storage. Fortunately, GNAT doesn't do that.
+
+      pragma Assert (not T.Locked);
+      pragma Assert (New_Last > T.P.Last_Allocated);
+
+      subtype Table_Length_Type is Table_Index_Type'Base
+        range 0 .. Table_Index_Type'Base'Last;
+
+      Old_Last_Allocated   : constant Table_Count_Type  := T.P.Last_Allocated;
+      Old_Allocated_Length : constant Table_Length_Type :=
+                               Old_Last_Allocated - First + 1;
+
+      New_Length : constant Table_Length_Type := New_Last - First + 1;
+      New_Allocated_Length : Table_Length_Type;
+
+   begin
+      if T.Table = Empty then
+         New_Allocated_Length := Table_Length_Type (Table_Initial);
+      else
+         New_Allocated_Length :=
+           Table_Length_Type
+             (Long_Long_Integer (Old_Allocated_Length) *
+               (100 + Long_Long_Integer (Table_Increment)) / 100);
+      end if;
+
+      --  Make sure it really did grow
+
+      if New_Allocated_Length <= Old_Allocated_Length then
+         New_Allocated_Length := Old_Allocated_Length + 10;
+      end if;
+
+      if New_Allocated_Length <= New_Length then
+         New_Allocated_Length := New_Length + 10;
+      end if;
+
+      pragma Assert (New_Allocated_Length > Old_Allocated_Length);
+      pragma Assert (New_Allocated_Length > New_Length);
+
+      T.P.Last_Allocated := First + New_Allocated_Length - 1;
+
+      declare
+         subtype Old_Alloc_Type is Table_Type (First .. Old_Last_Allocated);
+         type Old_Alloc_Ptr is access all Old_Alloc_Type;
+
+         procedure Free is
+           new Ada.Unchecked_Deallocation (Old_Alloc_Type, Old_Alloc_Ptr);
+         function To_Old_Alloc_Ptr is
+           new Ada.Unchecked_Conversion (Table_Ptr, Old_Alloc_Ptr);
+
+         subtype Alloc_Type is
+           Table_Type (First .. First + New_Allocated_Length - 1);
+         type Alloc_Ptr is access all Alloc_Type;
+
+         function To_Table_Ptr is
+           new Ada.Unchecked_Conversion (Alloc_Ptr, Table_Ptr);
+
+         Old_Table : Old_Alloc_Ptr := To_Old_Alloc_Ptr (T.Table);
+         New_Table : constant Alloc_Ptr := new Alloc_Type;
+
+      begin
+         if T.Table /= Empty then
+            New_Table (First .. T.P.Last) := Old_Table (First .. T.P.Last);
+            Free (Old_Table);
+         end if;
+
+         T.Table := To_Table_Ptr (New_Table);
+      end;
+
+      pragma Assert (New_Last <= T.P.Last_Allocated);
+      pragma Assert (T.Table /= null);
+      pragma Assert (T.Table /= Empty);
+   end Grow;
+
    --------------------
    -- Increment_Last --
    --------------------
 
    procedure Increment_Last (T : in out Instance) is
    begin
-      T.P.Last_Val := T.P.Last_Val + 1;
-
-      if T.P.Last_Val > T.P.Max then
-         Reallocate (T);
-      end if;
+      Allocate (T, 1);
    end Increment_Last;
 
    ----------
@@ -144,100 +237,57 @@ package body GNAT.Dynamic_Tables is
    ----------
 
    procedure Init (T : in out Instance) is
-      Old_Length : constant Integer := T.P.Length;
-
    begin
-      T.P.Last_Val := Min - 1;
-      T.P.Max      := Min + Table_Initial - 1;
-      T.P.Length   := T.P.Max - Min + 1;
-
-      --  If table is same size as before (happens when table is never
-      --  expanded which is a common case), then simply reuse it. Note
-      --  that this also means that an explicit Init call right after
-      --  the implicit one in the package body is harmless.
-
-      if Old_Length = T.P.Length then
-         return;
-
-      --  Otherwise we can use Reallocate to get a table of the right size.
-      --  Note that Reallocate works fine to allocate a table of the right
-      --  initial size when it is first allocated.
-
-      else
-         Reallocate (T);
-      end if;
+      Free (T);
    end Init;
 
    ----------
    -- Last --
    ----------
 
-   function Last (T : Instance) return Table_Index_Type is
+   function Last (T : Instance) return Table_Count_Type is
    begin
-      return Table_Index_Type (T.P.Last_Val);
+      return T.P.Last;
    end Last;
 
-   ----------------
-   -- Reallocate --
-   ----------------
-
-   procedure Reallocate (T : in out Instance) is
-      New_Length : Integer;
-      New_Size   : size_t;
+   -------------
+   -- Release --
+   -------------
 
+   procedure Release (T : in out Instance) is
+      pragma Assert (not T.Locked);
+      Old_Last_Allocated : constant Table_Count_Type := T.P.Last_Allocated;
    begin
-      if T.P.Max < T.P.Last_Val then
-
-         --  Now increment table length until it is sufficiently large. Use
-         --  the increment value or 10, which ever is larger (the reason
-         --  for the use of 10 here is to ensure that the table does really
-         --  increase in size (which would not be the case for a table of
-         --  length 10 increased by 3% for instance). Do the intermediate
-         --  calculation in Long_Long_Integer to avoid overflow.
-
-         while T.P.Max < T.P.Last_Val loop
-            New_Length :=
-              Integer
-                (Long_Long_Integer (T.P.Length) *
-                  (100 + Long_Long_Integer (Table_Increment)) / 100);
-
-            if New_Length > T.P.Length then
-               T.P.Length := New_Length;
-            else
-               T.P.Length := T.P.Length + 10;
-            end if;
-
-            T.P.Max := Min + T.P.Length - 1;
-         end loop;
-      end if;
+      if T.P.Last /= T.P.Last_Allocated then
+         pragma Assert (T.P.Last < T.P.Last_Allocated);
+         pragma Assert (T.Table /= Empty);
 
-      New_Size :=
-        size_t ((T.P.Max - Min + 1) *
-                (Table_Type'Component_Size / Storage_Unit));
+         declare
+            subtype Old_Alloc_Type is Table_Type (First .. Old_Last_Allocated);
+            type Old_Alloc_Ptr is access all Old_Alloc_Type;
 
-      if T.Table = null then
-         T.Table := To_Pointer (Alloc (New_Size));
+            procedure Free is
+              new Ada.Unchecked_Deallocation (Old_Alloc_Type, Old_Alloc_Ptr);
+            function To_Old_Alloc_Ptr is
+              new Ada.Unchecked_Conversion (Table_Ptr, Old_Alloc_Ptr);
 
-      elsif New_Size > 0 then
-         T.Table :=
-           To_Pointer (Realloc (Ptr  => To_Address (T.Table),
-                                Size => New_Size));
-      end if;
+            subtype Alloc_Type is
+              Table_Type (First .. First + T.P.Last - 1);
+            type Alloc_Ptr is access all Alloc_Type;
 
-      if T.P.Length /= 0 and then T.Table = null then
-         raise Storage_Error;
-      end if;
-   end Reallocate;
+            function To_Table_Ptr is
+              new Ada.Unchecked_Conversion (Alloc_Ptr, Table_Ptr);
 
-   -------------
-   -- Release --
-   -------------
+            Old_Table : Old_Alloc_Ptr := To_Old_Alloc_Ptr (T.Table);
+            New_Table : constant Alloc_Ptr := new Alloc_Type'(Old_Table.all);
+         begin
+            T.P.Last_Allocated := T.P.Last;
+            Free (Old_Table);
+            T.Table := To_Table_Ptr (New_Table);
+         end;
+      end if;
 
-   procedure Release (T : in out Instance) is
-   begin
-      T.P.Length := T.P.Last_Val - Integer (Table_Low_Bound) + 1;
-      T.P.Max    := T.P.Last_Val;
-      Reallocate (T);
+      pragma Assert (T.P.Last = T.P.Last_Allocated);
    end Release;
 
    --------------
@@ -245,60 +295,18 @@ package body GNAT.Dynamic_Tables is
    --------------
 
    procedure Set_Item
-      (T     : in out Instance;
-       Index : Table_Index_Type;
-       Item  : Table_Component_Type)
+     (T     : in out Instance;
+      Index : Valid_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 (T.Table'First .. Table_Index_Type (T.P.Max + 1));
-      --  A constrained table subtype one element larger than the currently
-      --  allocated table.
-
-      Allocated_Table_Address : constant System.Address :=
-                                  T.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);
-      pragma Suppress (Range_Check, On => 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
-      --  to the address just past the end of the current allocation). Range
-      --  checks are suppressed because this unit uses direct calls to
-      --  System.Memory for allocation, and this can yield misaligned storage
-      --  (and we cannot rely on the bootstrap compiler supporting specifically
-      --  disabling alignment checks, so we need to suppress all range checks).
-      --  It is safe to suppress this check here because we know that a
-      --  (possibly misaligned) object of that type does actually exist at that
-      --  address.
-      --  ??? We should really improve the allocation circuitry here to
-      --  guarantee proper alignment.
-
-      Need_Realloc : constant Boolean := Integer (Index) > T.P.Max;
-      --  True if this operation requires storage reallocation (which may
-      --  involve moving table contents around).
-
+      Item_Copy : constant Table_Component_Type := Item;
    begin
-      --  If we're going to reallocate, check whether 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 (T.P.Max + 1))'Address
-      then
-         --  If so, save a copy on the stack because Increment_Last will
-         --  reallocate storage and might deallocate the current table.
+      --  If Set_Last is going to reallocate the table, we make a copy of Item,
+      --  in case the call was "Set_Item (T, X, T.Table (Y));", and Item is
+      --  passed by reference. Without the copy, we would deallocate the array
+      --  containing Item, leaving a dangling pointer.
 
+      if Index > T.P.Last_Allocated then
          declare
             Item_Copy : constant Table_Component_Type := Item;
          begin
@@ -306,34 +314,28 @@ package body GNAT.Dynamic_Tables is
             T.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.
-
-         if Integer (Index) > T.P.Last_Val then
-            Set_Last (T, Index);
-         end if;
+         return;
+      end if;
 
-         T.Table (Index) := Item;
+      if Index > T.P.Last then
+         Set_Last (T, Index);
       end if;
+
+      T.Table (Index) := Item_Copy;
    end Set_Item;
 
    --------------
    -- Set_Last --
    --------------
 
-   procedure Set_Last (T : in out Instance; New_Val : Table_Index_Type) is
+   procedure Set_Last (T : in out Instance; New_Val : Table_Count_Type) is
+      pragma Assert (not T.Locked);
    begin
-      if Integer (New_Val) < T.P.Last_Val then
-         T.P.Last_Val := Integer (New_Val);
-
-      else
-         T.P.Last_Val := Integer (New_Val);
-
-         if T.P.Last_Val > T.P.Max then
-            Reallocate (T);
-         end if;
+      if New_Val > T.P.Last_Allocated then
+         Grow (T, New_Val);
       end if;
+
+      T.P.Last := New_Val;
    end Set_Last;
 
    ----------------
@@ -341,13 +343,12 @@ package body GNAT.Dynamic_Tables is
    ----------------
 
    procedure Sort_Table (Table : in out Instance) is
-
       Temp : Table_Component_Type;
       --  A temporary position to simulate index 0
 
       --  Local subprograms
 
-      function Index_Of (Idx : Natural) return Table_Index_Type;
+      function Index_Of (Idx : Natural) return Table_Index_Type'Base;
       --  Return index of Idx'th element of table
 
       function Lower_Than (Op1, Op2 : Natural) return Boolean;
@@ -362,11 +363,11 @@ package body GNAT.Dynamic_Tables is
       -- Index_Of --
       --------------
 
-      function Index_Of (Idx : Natural) return Table_Index_Type is
+      function Index_Of (Idx : Natural) return Table_Index_Type'Base is
          J : constant Integer'Base :=
-               Table_Index_Type'Pos (First) + Idx - 1;
+               Table_Index_Type'Base'Pos (First) + Idx - 1;
       begin
-         return Table_Index_Type'Val (J);
+         return Table_Index_Type'Base'Val (J);
       end Index_Of;
 
       ----------
@@ -401,8 +402,7 @@ package body GNAT.Dynamic_Tables is
 
          else
             return
-              Lt (Table.Table (Index_Of (Op1)),
-                   Table.Table (Index_Of (Op2)));
+              Lt (Table.Table (Index_Of (Op1)), Table.Table (Index_Of (Op2)));
          end if;
       end Lower_Than;
 
diff --git a/gcc/ada/g-dyntab.ads b/gcc/ada/g-dyntab.ads
index 59d9932..eb71815 100644
--- a/gcc/ada/g-dyntab.ads
+++ b/gcc/ada/g-dyntab.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2000-2015, AdaCore                     --
+--                     Copyright (C) 2000-2016, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -41,40 +41,49 @@
 --  instances of the table, while an instantiation of GNAT.Table creates a
 --  single instance of the table type.
 
---  Note that this interface should remain synchronized with those in
---  GNAT.Table and the GNAT compiler source unit Table to keep as much
---  coherency as possible between these three related units.
+--  Note that these three interfaces should remain synchronized to keep as much
+--  coherency as possible among these three related units:
+--
+--     GNAT.Dynamic_Tables
+--     GNAT.Table
+--     Table (the compiler unit)
 
 pragma Compiler_Unit_Warning;
 
+with Ada.Unchecked_Conversion;
+
 generic
    type Table_Component_Type is private;
    type Table_Index_Type     is range <>;
 
    Table_Low_Bound : Table_Index_Type;
-   Table_Initial   : Positive;
-   Table_Increment : Natural;
+   Table_Initial   : Positive := 8;
+   Table_Increment : Natural := 100;
 
 package GNAT.Dynamic_Tables is
 
-   --  Table_Component_Type and Table_Index_Type specify the type of the
-   --  array, Table_Low_Bound is the lower bound. Table_Index_Type must be an
-   --  integer type. The effect is roughly to declare:
+   --  Table_Component_Type and Table_Index_Type specify the type of the array,
+   --  Table_Low_Bound is the lower bound. The effect is roughly to declare:
 
    --    Table : array (Table_Low_Bound .. <>) of Table_Component_Type;
 
-   --    Note: since the upper bound can be one less than the lower
-   --    bound for an empty array, the table index type must be able
-   --    to cover this range, e.g. if the lower bound is 1, then the
-   --    Table_Index_Type should be Natural rather than Positive.
+   --  The lower bound of Table_Index_Type is ignored.
+
+   pragma Assert (Table_Low_Bound /= Table_Index_Type'Base'First);
+
+   function First return Table_Index_Type;
+   pragma Inline (First);
+   --  Export First as synonym for Table_Low_Bound (parallel with use of Last)
 
-   --  Table_Component_Type may be any Ada type, except that controlled
-   --  types are not supported. Note however that default initialization
-   --  will NOT occur for array components.
+   subtype Valid_Table_Index_Type is Table_Index_Type'Base
+     range Table_Low_Bound .. Table_Index_Type'Base'Last;
+   subtype Table_Count_Type is Table_Index_Type'Base
+     range Table_Low_Bound - 1 .. Table_Index_Type'Base'Last;
 
-   --  The Table_Initial values controls the allocation of the table when
-   --  it is first allocated, either by default, or by an explicit Init
-   --  call.
+   --  Table_Component_Type must not be a type with controlled parts.
+
+   --  The Table_Initial value controls the allocation of the table when
+   --  it is first allocated.
 
    --  The Table_Increment value controls the amount of increase, if the
    --  table has to be increased in size. The value given is a percentage
@@ -90,97 +99,114 @@ package GNAT.Dynamic_Tables is
    --  to take the access of a table element, use Unrestricted_Access.
 
    type Table_Type is
-     array (Table_Index_Type range <>) of Table_Component_Type;
+     array (Valid_Table_Index_Type range <>) of Table_Component_Type;
    subtype Big_Table_Type is
-     Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
+     Table_Type (Table_Low_Bound .. Valid_Table_Index_Type'Last);
    --  We work with pointers to a bogus array type that is constrained with
    --  the maximum possible range bound. This means that the pointer is a thin
    --  pointer, which is more efficient. Since subscript checks in any case
    --  must be on the logical, rather than physical bounds, safety is not
-   --  compromised by this approach. These types should not be used by the
-   --  client.
+   --  compromised by this approach.
+
+   --  To get subscript checking, rename a slice of the Table, like this:
+
+   --     Table : Table_Type renames T.Table (First .. Last (T));
+
+   --  and the refer to components of Table.
 
    type Table_Ptr is access all Big_Table_Type;
    for Table_Ptr'Storage_Size use 0;
-   --  The table is actually represented as a pointer to allow reallocation.
-   --  This type should not be used by the client.
+   --  The table is actually represented as a pointer to allow reallocation
 
    type Table_Private is private;
    --  Table private data that is not exported in Instance
 
+   --  Private use only:
+   subtype Empty_Table_Array_Type is
+     Table_Type (Table_Low_Bound .. Table_Low_Bound - 1);
+   type Empty_Table_Array_Ptr is access all Empty_Table_Array_Type;
+   Empty_Table_Array : aliased Empty_Table_Array_Type;
+   function Empty_Table_Array_Ptr_To_Table_Ptr is
+     new Ada.Unchecked_Conversion (Empty_Table_Array_Ptr, Table_Ptr);
+   --  End private use only. The above are used to initialize Table to point to
+   --  an empty array.
+
    type Instance is record
-      Table : aliased Table_Ptr := null;
-   --  The table itself. The lower bound is the value of Low_Bound.
-   --  Logically the upper bound is the current value of Last (although
-   --  the actual size of the allocated table may be larger than this).
-   --  The program may only access and modify Table entries in the
-   --  range First .. Last.
+      Table : aliased Table_Ptr :=
+                Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access);
+      --  The table itself. The lower bound is the value of First. Logically
+      --  the upper bound is the current value of Last (although the actual
+      --  size of the allocated table may be larger than this). The program may
+      --  only access and modify Table entries in the range First .. Last.
+      --
+      --  It's a good idea to access this via a renaming of a slice, in order
+      --  to ensure bounds checking, as in:
+      --
+      --     Tab : Table_Type renames X.Table (First .. X.Last);
+
+      Locked : Boolean := False;
+      --  Table expansion is permitted only if this switch is set to False. A
+      --  client may set Locked to True, in which case any attempt to expand
+      --  the table will cause an assertion failure. Note that while a table
+      --  is locked, its address in memory remains fixed and unchanging.
 
       P : Table_Private;
    end record;
 
    procedure Init (T : in out Instance);
-   --  This procedure allocates a new table of size Initial (freeing any
-   --  previously allocated larger table). Init must be called before using
-   --  the table. Init is convenient in reestablishing a table for new use.
+   --  Reinitializes the table to empty. There is no need to call this before
+   --  using a table; tables default to empty.
 
-   function Last (T : Instance) return Table_Index_Type;
+   function Last (T : Instance) return Table_Count_Type;
    pragma Inline (Last);
-   --  Returns the current value of the last used entry in the table,
-   --  which can then be used as a subscript for Table. Note that the
-   --  only way to modify Last is to call the Set_Last procedure. Last
-   --  must always be used to determine the logically last entry.
+   --  Returns the current value of the last used entry in the table, which can
+   --  then be used as a subscript for Table.
 
    procedure Release (T : in out Instance);
    --  Storage is allocated in chunks according to the values given in the
-   --  Initial and Increment parameters. A call to Release releases all
-   --  storage that is allocated, but is not logically part of the current
+   --  Table_Initial and Table_Increment parameters. A call to Release releases
+   --  all storage that is allocated, but is not logically part of the current
    --  array value. Current array values are not affected by this call.
 
    procedure Free (T : in out Instance);
-   --  Free all allocated memory for the table. A call to init is required
-   --  before any use of this table after calling Free.
+   --  Same as Init
 
-   First : constant Table_Index_Type := Table_Low_Bound;
-   --  Export First as synonym for Low_Bound (parallel with use of Last)
-
-   procedure Set_Last (T : in out Instance; New_Val : Table_Index_Type);
+   procedure Set_Last (T : in out Instance; New_Val : Table_Count_Type);
    pragma Inline (Set_Last);
-   --  This procedure sets Last to the indicated value. If necessary the
-   --  table is reallocated to accommodate the new value (i.e. on return
-   --  the allocated table has an upper bound of at least Last). If
-   --  Set_Last reduces the size of the table, then logically entries are
-   --  removed from the table. If Set_Last increases the size of the
-   --  table, then new entries are logically added to the table.
+   --  This procedure sets Last to the indicated value. If necessary the table
+   --  is reallocated to accommodate the new value (i.e. on return the
+   --  allocated table has an upper bound of at least Last). If Set_Last
+   --  reduces the size of the table, then logically entries are removed from
+   --  the table. If Set_Last increases the size of the table, then new entries
+   --  are logically added to the table.
 
    procedure Increment_Last (T : in out Instance);
    pragma Inline (Increment_Last);
-   --  Adds 1 to Last (same as Set_Last (Last + 1)
+   --  Adds 1 to Last (same as Set_Last (Last + 1))
 
    procedure Decrement_Last (T : in out Instance);
    pragma Inline (Decrement_Last);
-   --  Subtracts 1 from Last (same as Set_Last (Last - 1)
+   --  Subtracts 1 from Last (same as Set_Last (Last - 1))
 
    procedure Append (T : in out Instance; New_Val : Table_Component_Type);
    pragma Inline (Append);
+   --  Appends New_Val onto the end of the table
    --  Equivalent to:
    --    Increment_Last (T);
    --    T.Table (T.Last) := New_Val;
-   --  i.e. the table size is increased by one, and the given new item
-   --  stored in the newly created table element.
 
    procedure Append_All (T : in out Instance; New_Vals : Table_Type);
    --  Appends all components of New_Vals
 
    procedure Set_Item
      (T     : in out Instance;
-      Index : Table_Index_Type;
+      Index : Valid_Table_Index_Type;
       Item  : Table_Component_Type);
    pragma Inline (Set_Item);
-   --  Put Item in the table at position Index. The table is expanded if
-   --  current table length is less than Index and in that case Last is set to
-   --  Index. Item will replace any value already present in the table at this
-   --  position.
+   --  Put Item in the table at position Index. If Index points to an existing
+   --  item (i.e. it is in the range First .. Last (T)), the item is replaced.
+   --  Otherwise (i.e. Index > Last (T), the table is expanded, and Last is set
+   --  to Index.
 
    procedure Allocate (T : in out Instance; Num : Integer := 1);
    pragma Inline (Allocate);
@@ -188,17 +214,17 @@ package GNAT.Dynamic_Tables is
 
    generic
      with procedure Action
-       (Index : Table_Index_Type;
+       (Index : Valid_Table_Index_Type;
         Item  : Table_Component_Type;
         Quit  : in out Boolean) is <>;
    procedure For_Each (Table : Instance);
-   --  Calls procedure Action for each component of the table Table, or until
-   --  one of these calls set Quit to True.
+   --  Calls procedure Action for each component of the table, or until one of
+   --  these calls set Quit to True.
 
    generic
      with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean;
    procedure Sort_Table (Table : in out Instance);
-   --  This procedure sorts the components of table Table into ascending
+   --  This procedure sorts the components of the table into ascending
    --  order making calls to Lt to do required comparisons, and using
    --  assignments to move components around. The Lt function returns True
    --  if Comp1 is less than Comp2 (in the sense of the desired sort), and
@@ -208,16 +234,16 @@ package GNAT.Dynamic_Tables is
    --  in the table is not preserved).
 
 private
+
    type Table_Private is record
-      Max : Integer;
-      --  Subscript of the maximum entry in the currently allocated table
+      Last_Allocated : Table_Count_Type := Table_Low_Bound - 1;
+      --  Subscript of the maximum entry in the currently allocated table.
+      --  Initial value ensures that we initially allocate the table.
 
-      Length : Integer := 0;
-      --  Number of entries in currently allocated table. The value of zero
-      --  ensures that we initially allocate the table.
+      Last : Table_Count_Type := Table_Low_Bound - 1;
+      --  Current value of Last function
 
-      Last_Val : Integer;
-      --  Current value of Last
+      --  Invariant: Last <= Last_Allocated
    end record;
 
 end GNAT.Dynamic_Tables;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index cd7691f..4e00e17 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -68,6 +68,7 @@ with Stand;    use Stand;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with System;
+with System.CRC32; use System.CRC32;
 with Stringt;  use Stringt;
 with Style;
 with Stylesw;  use Stylesw;
@@ -6139,37 +6140,142 @@ package body Sem_Attr is
          Check_E0;
          Check_Type;
 
-         --  This processing belongs in Eval_Attribute ???
-
          declare
-            function Type_Key return String_Id;
-            --  A very preliminary implementation. For now, a signature
-            --  consists of only the type name. This is clearly incomplete
-            --  (e.g., adding a new field to a record type should change the
-            --  type's Type_Key attribute).
+            Full_Name  : constant String_Id :=
+              Fully_Qualified_Name_String (Entity (P));
+
+            Deref      : Boolean;
+            --  To simplify the handling of mutually recursive types, follow
+            --  a single dereference link in a composite type.
+
+            CRC        : CRC32;
+            --  The computed signature for the type.
+
+            procedure Compute_Type_Key (T : Entity_Id);
+            --  Create a CRC integer from the declaration of the type, For
+            --  a composite type, fold in the representation of its components
+            --  in recursive fashion. We use directly the source representation
+            --  of the types involved.
 
             --------------
             -- Type_Key --
             --------------
 
-            function Type_Key return String_Id is
-               Full_Name : constant String_Id :=
-                             Fully_Qualified_Name_String (Entity (P));
+            procedure Compute_Type_Key (T : Entity_Id)  is
+               SFI          : Source_File_Index;
+               Buffer       : Source_Buffer_Ptr;
+               P_Min, P_Max : Source_Ptr;
+               Rep          : Node_Id;
 
-            begin
-               --  Copy all characters in Full_Name but the trailing NUL
+               procedure Process_One_Declaration;
+               --  Update CRC with the characters of one type declaration,
+               --  or a representation pragma that applies to the type.
 
-               Start_String;
-               for J in 1 .. String_Length (Full_Name) - 1 loop
-                  Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
-               end loop;
+               -----------------------------
+               -- Process_One_Declaration --
+               -----------------------------
+
+               procedure Process_One_Declaration is
+                  Ptr : Source_Ptr;
+
+               begin
+                  Ptr := P_Min;
+
+                  --  Scan type declaration, skipping blanks,
+
+                  while Ptr <= P_Max loop
+                     if Buffer (Ptr) /= ' ' then
+                        System.CRC32.Update (CRC, Buffer (Ptr));
+                     end if;
+
+                     Ptr := Ptr + 1;
+                  end loop;
+               end Process_One_Declaration;
+
+            begin  --  Start of processing for Compute_Type_Key
+
+               if Is_Itype (T) then
+                  return;
+               end if;
+
+               Sloc_Range (Enclosing_Declaration (T), P_Min, P_Max);
+               SFI        := Get_Source_File_Index (P_Min);
+               Buffer     := Source_Text (SFI);
+
+               Process_One_Declaration;
+
+               --  Recurse on relevant component types.
+
+               if Is_Array_Type (T) then
+                  Compute_Type_Key (Component_Type (T));
+
+               elsif Is_Access_Type (T) then
+                  if not Deref then
+                     Deref := True;
+                     Compute_Type_Key (Designated_Type (T));
+                  end if;
 
-               Store_String_Chars ("'Type_Key");
-               return End_String;
-            end Type_Key;
+               elsif Is_Derived_Type (T) then
+                  Compute_Type_Key (Etype  (T));
+
+               elsif Is_Record_Type (T) then
+                  declare
+                     Comp : Entity_Id;
+                  begin
+                     Comp := First_Component (T);
+                     while Present (Comp) loop
+                        Compute_Type_Key (Etype (Comp));
+
+                        Next_Component (Comp);
+                     end loop;
+                  end;
+               end if;
+
+               --  Fold in representation aspects for the type, which
+               --  appear in the same source buffer.
+
+               Rep := First_Rep_Item (T);
+
+               while Present (Rep) loop
+                  if Comes_From_Source (Rep) then
+                     Sloc_Range (Rep, P_Min, P_Max);
+                     Process_One_Declaration;
+                  end if;
+
+                  Rep := Next_Rep_Item (Rep);
+               end loop;
+            end Compute_Type_Key;
 
          begin
-            Rewrite (N, Make_String_Literal (Loc, Type_Key));
+            Start_String;
+            Deref := False;
+
+            --  Copy all characters in Full_Name but the trailing NUL
+
+            for J in 1 .. String_Length (Full_Name) - 1 loop
+               Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
+            end loop;
+
+            --  For standard type return the name of the type. as there is
+            --  no explicit source declaration to use. Otherwise compute
+            --  CRC and convert it to string one character at a time. so as
+            --  not to use Image within the compiler.
+
+            if Scope (Entity (P)) /= Standard_Standard then
+               Initialize (CRC);
+               Compute_Type_Key (Entity (P));
+
+               if not Is_Frozen (Entity (P)) then
+                  Error_Msg_N ("premature usage of Type_Key?", N);
+               end if;
+
+               while CRC > 0 loop
+                  Store_String_Char (Character'Val (48 + (CRC rem 10)));
+                  CRC := CRC / 10;
+               end loop;
+            end if;
+
+            Rewrite (N, Make_String_Literal (Loc, End_String));
          end;
 
          Analyze_And_Resolve (N, Standard_String);
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 8df46f06..7415b0c 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -114,10 +114,12 @@ package body Sem_Case is
       Others_Present : Boolean;
       Case_Node      : Node_Id)
    is
-      Predicate_Error : Boolean;
+      Predicate_Error : Boolean := False;
       --  Flag to prevent cascaded errors when a static predicate is known to
       --  be violated by one choice.
 
+      Num_Choices : constant Nat := Choice_Table'Last;
+
       procedure Check_Against_Predicate
         (Pred    : in out Node_Id;
          Choice  : Choice_Bounds;
@@ -130,6 +132,10 @@ package body Sem_Case is
       --  choice that covered a predicate set. Error denotes whether the check
       --  found an illegal intersection.
 
+      procedure Check_Duplicates;
+      --  Check for duplicate choices, and call Dup_Choice is there are any
+      --  such errors. Note that predicates are irrelevant here.
+
       procedure Dup_Choice (Lo, Hi : Uint; C : Node_Id);
       --  Post message "duplication of choice value(s) bla bla at xx". Message
       --  is posted at location C. Caller sets Error_Msg_Sloc for xx.
@@ -236,8 +242,7 @@ package body Sem_Case is
             Val : Uint) return Boolean
          is
          begin
-            return
-              Val = Lo or else Val = Hi or else (Lo < Val and then Val < Hi);
+            return Lo <= Val and then Val <= Hi;
          end Inside_Range;
 
          --  Local variables
@@ -276,14 +281,12 @@ package body Sem_Case is
             return;
          end if;
 
-         --  Step 1: Detect duplicate choices
-
-         if Inside_Range (Choice_Lo, Choice_Hi, Prev_Lo) then
-            Dup_Choice (Prev_Lo, UI_Min (Prev_Hi, Choice_Hi), LocN);
-            Error := True;
+         --  Step 1: Ignore duplicate choices, other than to set the flag,
+         --  because these were already detected by Check_Duplicates.
 
-         elsif Inside_Range (Choice_Lo, Choice_Hi, Prev_Hi) then
-            Dup_Choice (UI_Max (Choice_Lo, Prev_Lo), Prev_Hi, LocN);
+         if Inside_Range (Choice_Lo, Choice_Hi, Prev_Lo)
+           or else  Inside_Range (Choice_Lo, Choice_Hi, Prev_Hi)
+         then
             Error := True;
 
          --  Step 2: Detect full coverage
@@ -447,6 +450,59 @@ package body Sem_Case is
          end if;
       end Check_Against_Predicate;
 
+      ----------------------
+      -- Check_Duplicates --
+      ----------------------
+
+      procedure Check_Duplicates is
+         Prev_Hi : Uint := Expr_Value (Choice_Table (1).Hi);
+      begin
+         for Outer_Index in 2 .. Num_Choices loop
+            declare
+               Choice_Lo : constant Uint :=
+                 Expr_Value (Choice_Table (Outer_Index).Lo);
+               Choice_Hi : constant Uint :=
+                 Expr_Value (Choice_Table (Outer_Index).Hi);
+            begin
+               if Choice_Lo <= Prev_Hi then
+                  --  Choices overlap; this is an error
+
+                  declare
+                     Choice : constant Node_Id :=
+                       Choice_Table (Outer_Index).Node;
+                     Prev_Choice : Node_Id;
+                  begin
+                     --  Find first previous choice that overlaps
+
+                     for Inner_Index in 1 .. Outer_Index - 1 loop
+                        if Choice_Lo <=
+                             Expr_Value (Choice_Table (Inner_Index).Hi)
+                        then
+                           Prev_Choice := Choice_Table (Inner_Index).Node;
+                           exit;
+                        end if;
+                     end loop;
+
+                     if Sloc (Prev_Choice) <= Sloc (Choice) then
+                        Error_Msg_Sloc := Sloc (Prev_Choice);
+                        Dup_Choice
+                          (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Choice);
+                     else
+                        Error_Msg_Sloc := Sloc (Choice);
+                        Dup_Choice
+                          (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi),
+                           Prev_Choice);
+                     end if;
+                  end;
+               end if;
+
+               if Choice_Hi > Prev_Hi then
+                  Prev_Hi := Choice_Hi;
+               end if;
+            end;
+         end loop;
+      end Check_Duplicates;
+
       ----------------
       -- Dup_Choice --
       ----------------
@@ -709,17 +765,13 @@ package body Sem_Case is
 
       Bounds_Hi     : constant Node_Id := Type_High_Bound (Bounds_Type);
       Bounds_Lo     : constant Node_Id := Type_Low_Bound  (Bounds_Type);
-      Num_Choices   : constant Nat     := Choice_Table'Last;
       Has_Predicate : constant Boolean :=
                         Is_OK_Static_Subtype (Bounds_Type)
                           and then Has_Static_Predicate (Bounds_Type);
 
-      Choice      : Node_Id;
       Choice_Hi   : Uint;
       Choice_Lo   : Uint;
-      Error       : Boolean;
       Pred        : Node_Id;
-      Prev_Choice : Node_Id;
       Prev_Lo     : Uint;
       Prev_Hi     : Uint;
 
@@ -735,8 +787,6 @@ package body Sem_Case is
          return;
       end if;
 
-      Predicate_Error := False;
-
       --  Choice_Table must start at 0 which is an unused location used by the
       --  sorting algorithm. However the first valid position for a discrete
       --  choice is 1.
@@ -756,16 +806,22 @@ package body Sem_Case is
 
       Sorting.Sort (Positive (Choice_Table'Last));
 
-      --  The type covered by the list of choices is actually a static subtype
-      --  subject to a static predicate. The predicate defines subsets of legal
-      --  values and requires finer grained analysis.
+      --  First check for duplicates. This involved the choices; predicates, if
+      --  any, are irrelevant.
+
+      Check_Duplicates;
+
+      --  Then check for overlaps
+
+      --  If the subtype has a static predicate, the predicate defines subsets
+      --  of legal values and requires finer grained analysis.
 
       --  Note that in GNAT the predicate is considered static if the predicate
       --  expression is static, independently of whether the aspect mentions
       --  Static explicitly.
 
       if Has_Predicate then
-         Pred    := First (Static_Discrete_Predicate (Bounds_Type));
+         Pred := First (Static_Discrete_Predicate (Bounds_Type));
 
          --  Make initial value smaller than 'First of type, so that first
          --  range comparison succeeds. This applies both to integer types
@@ -774,28 +830,30 @@ package body Sem_Case is
          Prev_Lo := Expr_Value (Type_Low_Bound (Bounds_Type)) - 1;
          Prev_Hi := Prev_Lo;
 
-         Error   := False;
-
-         for Index in 1 .. Num_Choices loop
-            Check_Against_Predicate
-              (Pred    => Pred,
-               Choice  => Choice_Table (Index),
-               Prev_Lo => Prev_Lo,
-               Prev_Hi => Prev_Hi,
-               Error   => Error);
-
-            --  The analysis detected an illegal intersection between a choice
-            --  and a static predicate set. Do not examine other choices unless
-            --  all errors are requested.
-
-            if Error then
-               Predicate_Error := True;
-
-               if not All_Errors_Mode then
-                  return;
+         declare
+            Error : Boolean := False;
+         begin
+            for Index in 1 .. Num_Choices loop
+               Check_Against_Predicate
+                 (Pred    => Pred,
+                  Choice  => Choice_Table (Index),
+                  Prev_Lo => Prev_Lo,
+                  Prev_Hi => Prev_Hi,
+                  Error   => Error);
+
+               --  The analysis detected an illegal intersection between a
+               --  choice and a static predicate set. Do not examine other
+               --  choices unless all errors are requested.
+
+               if Error then
+                  Predicate_Error := True;
+
+                  if not All_Errors_Mode then
+                     return;
+                  end if;
                end if;
-            end if;
-         end loop;
+            end loop;
+         end;
 
          if Predicate_Error then
             return;
@@ -826,35 +884,11 @@ package body Sem_Case is
             end if;
          end if;
 
-         for Outer_Index in 2 .. Num_Choices loop
-            Choice_Lo := Expr_Value (Choice_Table (Outer_Index).Lo);
-            Choice_Hi := Expr_Value (Choice_Table (Outer_Index).Hi);
-
-            if Choice_Lo <= Prev_Hi then
-               Choice := Choice_Table (Outer_Index).Node;
-
-               --  Find first previous choice that overlaps
-
-               for Inner_Index in 1 .. Outer_Index - 1 loop
-                  if Choice_Lo <=
-                       Expr_Value (Choice_Table (Inner_Index).Hi)
-                  then
-                     Prev_Choice := Choice_Table (Inner_Index).Node;
-                     exit;
-                  end if;
-               end loop;
-
-               if Sloc (Prev_Choice) <= Sloc (Choice) then
-                  Error_Msg_Sloc := Sloc (Prev_Choice);
-                  Dup_Choice
-                    (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Choice);
-               else
-                  Error_Msg_Sloc := Sloc (Choice);
-                  Dup_Choice
-                    (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Prev_Choice);
-               end if;
+         for Index in 2 .. Num_Choices loop
+            Choice_Lo := Expr_Value (Choice_Table (Index).Lo);
+            Choice_Hi := Expr_Value (Choice_Table (Index).Hi);
 
-            elsif not Others_Present and then Choice_Lo /= Prev_Hi + 1 then
+            if Choice_Lo > Prev_Hi + 1 and then not Others_Present then
                Missing_Choice (Prev_Hi + 1, Choice_Lo - 1);
             end if;
 
diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb
index 3f882b0..c43c575 100644
--- a/gcc/ada/xref_lib.adb
+++ b/gcc/ada/xref_lib.adb
@@ -401,8 +401,9 @@ package body Xref_Lib is
      (File : ALI_File;
       Num  : Positive) return File_Reference
    is
+      Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep));
    begin
-      return File.Dep.Table (Num);
+      return Table (Num);
    end File_Name;
 
    --------------------
@@ -642,10 +643,15 @@ package body Xref_Lib is
                Token := Gnatchop_Name + 1;
             end if;
 
-            File.Dep.Table (Num_Dependencies) := Add_To_Xref_File
-              (Ali (File_Start .. File_End),
-               Gnatchop_File => Ali (Token .. Ptr - 1),
-               Gnatchop_Offset => Gnatchop_Offset);
+            declare
+               Table : Table_Type renames
+                 File.Dep.Table (1 .. Last (File.Dep));
+            begin
+               Table (Num_Dependencies) := Add_To_Xref_File
+                 (Ali (File_Start .. File_End),
+                  Gnatchop_File => Ali (Token .. Ptr - 1),
+                  Gnatchop_Offset => Gnatchop_Offset);
+            end;
 
          elsif W_Lines and then Ali (Ptr) = 'W' then
 
@@ -854,6 +860,8 @@ package body Xref_Lib is
          Ptr := Ptr + 1;
       end Skip_To_Matching_Closing_Bracket;
 
+      Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep));
+
    --  Start of processing for Parse_Identifier_Info
 
    begin
@@ -976,9 +984,9 @@ package body Xref_Lib is
                   --  We don't have a unit number specified, so we set P_Eun to
                   --  the current unit.
 
-                  for K in Dependencies_Tables.First .. Last (File.Dep) loop
+                  for K in Table'Range loop
                      P_Eun := K;
-                     exit when File.Dep.Table (K) = File_Ref;
+                     exit when Table (K) = File_Ref;
                   end loop;
                end if;
 
@@ -1011,7 +1019,7 @@ package body Xref_Lib is
                            Symbol,
                            P_Line,
                            P_Column,
-                           File.Dep.Table (P_Eun));
+                           Table (P_Eun));
                      end if;
                   end;
                end if;
@@ -1029,7 +1037,7 @@ package body Xref_Lib is
                      Add_Entity
                        (Pattern,
                         Get_Symbol_Name (P_Eun, P_Line, P_Column)
-                        & ':' & Get_Gnatchop_File (File.Dep.Table (P_Eun))
+                        & ':' & Get_Gnatchop_File (Table (P_Eun))
                         & ':' & Get_Line (Get_Parent (Decl_Ref))
                         & ':' & Get_Column (Get_Parent (Decl_Ref)),
                         False);
@@ -1080,11 +1088,10 @@ package body Xref_Lib is
 
       if Wide_Search then
          declare
-            File_Ref : File_Reference;
-            pragma Unreferenced (File_Ref);
             File_Name : constant String := Get_Gnatchop_File (File.X_File);
+            Ignored : File_Reference;
          begin
-            File_Ref := Add_To_Xref_File (ALI_File_Name (File_Name), False);
+            Ignored := Add_To_Xref_File (ALI_File_Name (File_Name), False);
          end;
       end if;
 
@@ -1252,6 +1259,8 @@ package body Xref_Lib is
       Ptr     : Positive renames File.Current_Line;
       File_Nr : Natural;
 
+      Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep));
+
    begin
       while Ali (Ptr) = 'X' loop
 
@@ -1267,8 +1276,8 @@ package body Xref_Lib is
 
          --  If the referenced file is unknown, we simply ignore it
 
-         if File_Nr in Dependencies_Tables.First .. Last (File.Dep) then
-            File.X_File := File.Dep.Table (File_Nr);
+         if File_Nr in Table'Range then
+            File.X_File := Table (File_Nr);
          else
             File.X_File := Empty_File;
          end if;