2014-02-19 Matthew Heaney <heaney@adacore.com>

	* a-chtgop.ads (Checked_Index): New operation.
	(Next): Changed mode of hash table.
	* a-chtgop.adb (Adjust, Delete_Node_Sans_Free): Detect tampering
	(Generic_Read, Reserve_Capacity): Ditto.
	(Generic_Equal): Detect tampering.
	(Next): Changed mode of hash table, detect tampering.
	* a-chtgke.ads (Checked_Index, Checked_Equivalent_Keys): New
	operation.
	(Find): Changed mode of hash table.
	* a-chtgke.adb (Checked_Equivalent_Keys): New operation
	(Delete_Key_Sans_Free, Generic_Conditional_Insert): Detect
	tampering.
	(Find): Changed mode of hash table, check for tampering.
	(Generic_Replace_Element): Check for tampering.
	* a-chtgbk.ads (Checked_Index, Checked_Equivalent_Keys): New operation.
	* a-chtgbk.adb (Checked_Index, Checked_Equivalent_Keys): New
	operation (Delete_Key_Sans_Free, Generic_Conditional_Insert):
	Detect tampering.
	(Find, Generic_Replace_Element): Check for tampering.
	* a-chtgbo.ads (Checked_Index): New operation.
	* a-chtgbo.adb (Checked_Index): New operation
	(Delete_Node_Sans_Free, Generic_Equal): Detect tampering.
	(Generic_Read, Next): Ditto.
	* a-cohase.adb, a-cihase.adb (Is_In): Changed mode of hash
	table (Difference, Intersection): Use variable view of
	source, detect tampering (Find, Is_Subset, Overlap): Use
	variable view of container (Symmetric_Difference, Union):
	Detect tampering (Vet): Use Checked_Index to detect tampering
	(Constant_Reference, Element, Find): Use variable view of
	container.
	(Update_Element_Preserving_Key): Detect tampering.
	* a-cbhase.adb (Difference, Find, Is_In): Use variable view
	of container.
	(Is_Subset): Ditto.
	(Equivalent_Sets, Overlap): Use Node's Next component.
	(Vet): Use Checked_Index to detect tampering.
	(Constant_Reference, Element, Find): Use variable view of container.
	(Update_Element_Preserving_Key): Detect tampering.
	* a-cohama.adb, a-cihama.adb, a-cbhama.adb (Constant_Reference,
	Element, Find): Use variable view of container.
	(Reference): Rename hash table component.
	(Vet): Use Checked_Index to detect tampering.

2014-02-19  Arnaud Charlet  <charlet@adacore.com>

	* adabkend.adb (Scan_Compiler_Arguments): Add missing handling
	of -nostdinc.

2014-02-19  Thomas Quinot  <quinot@adacore.com>

	* tbuild.adb (New_Occurrence_Of, New_Rerefence_To): Guard
	against calls without Def_Id.

2014-02-19  Claire Dross  <dross@adacore.com>

	* a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads, a-cforse.ads,
	a-cofove.ads: Add global annotations to subprograms.

2014-02-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Initial_Condition_In_Decl_Part): Remove
	constants Errors, Pack_Id and Pack_Init. Remove variable Vars.
	Initial_Condition no longer requires the presence of pragma
	Initialized. Do not try to diagnose whether all variables mentioned in
	pragma Initializes also appear in Initial_Condition.
	(Collect_Variables): Removed.
	(Match_Variable): Removed.
	(Match_Variables): Removed.
	(Report_Unused_Variables): Removed.

2014-02-19  Thomas Quinot  <quinot@adacore.com>

	* gnat_rm.texi (pragma Stream_Convert): Minor rewording.



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

1 files changed, 91 insertions, 11 deletions

diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb
index d014dc17c09..a0e0af16493 100644
--- a/gcc/ada/a-chtgop.adb
+++ b/gcc/ada/a-chtgop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -75,7 +75,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
 
                --  See note above
 
-               pragma Assert (Index (HT, Dst_Node) = Src_Index);
+               pragma Assert (Checked_Index (HT, Dst_Node) = Src_Index);
 
             begin
                HT.Buckets (Src_Index) := Dst_Node;
@@ -91,7 +91,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
 
                   --  See note above
 
-                  pragma Assert (Index (HT, Dst_Node) = Src_Index);
+                  pragma Assert (Checked_Index (HT, Dst_Node) = Src_Index);
 
                begin
                   Set_Next (Node => Dst_Prev, Next => Dst_Node);
@@ -121,6 +121,46 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       return HT.Buckets'Length;
    end Capacity;
 
+   -------------------
+   -- Checked_Index --
+   -------------------
+
+   function Checked_Index
+     (Hash_Table : aliased in out Hash_Table_Type;
+      Buckets    : Buckets_Type;
+      Node       : Node_Access) return Hash_Type
+   is
+      Result : Hash_Type;
+
+      B : Natural renames Hash_Table.Busy;
+      L : Natural renames Hash_Table.Lock;
+
+   begin
+      B := B + 1;
+      L := L + 1;
+
+      Result := Index (Buckets, Node);
+
+      B := B - 1;
+      L := L - 1;
+
+      return Result;
+   exception
+      when others =>
+         B := B - 1;
+         L := L - 1;
+
+         raise;
+   end Checked_Index;
+
+   function Checked_Index
+     (Hash_Table : aliased in out Hash_Table_Type;
+      Node       : Node_Access) return Hash_Type
+   is
+   begin
+      return Checked_Index (Hash_Table, Hash_Table.Buckets.all, Node);
+   end Checked_Index;
+
    -----------
    -- Clear --
    -----------
@@ -174,7 +214,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
            "attempt to delete node from empty hashed container";
       end if;
 
-      Indx := Index (HT, X);
+      Indx := Checked_Index (HT, X);
       Prev := HT.Buckets (Indx);
 
       if Prev = null then
@@ -288,6 +328,14 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
    function Generic_Equal
      (L, R : Hash_Table_Type) return Boolean
    is
+      BL : Natural renames L'Unrestricted_Access.Busy;
+      LL : Natural renames L'Unrestricted_Access.Lock;
+
+      BR : Natural renames R'Unrestricted_Access.Busy;
+      LR : Natural renames R'Unrestricted_Access.Lock;
+
+      Result : Boolean;
+
       L_Index : Hash_Type;
       L_Node  : Node_Access;
 
@@ -315,13 +363,23 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          L_Index := L_Index + 1;
       end loop;
 
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      BL := BL + 1;
+      LL := LL + 1;
+
+      BR := BR + 1;
+      LR := LR + 1;
+
       --  For each node of hash table L, search for an equivalent node in hash
       --  table R.
 
       N := L.Length;
       loop
          if not Find (HT => R, Key => L_Node) then
-            return False;
+            Result := False;
+            exit;
          end if;
 
          N := N - 1;
@@ -332,7 +390,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
             --  We have exhausted the nodes in this bucket
 
             if N = 0 then
-               return True;
+               Result := True;
+               exit;
             end if;
 
             --  Find the next bucket
@@ -344,6 +403,23 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
             end loop;
          end if;
       end loop;
+
+      BL := BL - 1;
+      LL := LL - 1;
+
+      BR := BR - 1;
+      LR := LR - 1;
+
+      return Result;
+   exception
+      when others =>
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         raise;
    end Generic_Equal;
 
    -----------------------
@@ -407,7 +483,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       for J in 1 .. N loop
          declare
             Node : constant Node_Access := New_Node (Stream);
-            Indx : constant Hash_Type := Index (HT, Node);
+            Indx : constant Hash_Type := Checked_Index (HT, Node);
             B    : Node_Access renames HT.Buckets (Indx);
          begin
             Set_Next (Node => Node, Next => B);
@@ -513,17 +589,21 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
    ----------
 
    function Next
-     (HT   : Hash_Table_Type;
+     (HT   : aliased in out Hash_Table_Type;
       Node : Node_Access) return Node_Access
    is
-      Result : Node_Access := Next (Node);
+      Result : Node_Access;
+      First  : Hash_Type;
 
    begin
+      Result := Next (Node);
+
       if Result /= null then
          return Result;
       end if;
 
-      for Indx in Index (HT, Node) + 1 .. HT.Buckets'Last loop
+      First := Checked_Index (HT, Node) + 1;
+      for Indx in First .. HT.Buckets'Last loop
          Result := HT.Buckets (Indx);
 
          if Result /= null then
@@ -643,7 +723,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
                      Src_Node : constant Node_Access := Src_Bucket;
 
                      Dst_Index : constant Hash_Type :=
-                       Index (Dst_Buckets.all, Src_Node);
+                       Checked_Index (HT, Dst_Buckets.all, Src_Node);
 
                      Dst_Bucket : Node_Access renames Dst_Buckets (Dst_Index);