sem_ch13.adb (Analyze_One_Aspect): Avoid analyzing the expression in a 'Disable_Controlled attribute when...

2015-10-20  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Analyze_One_Aspect): Avoid
	analyzing the expression in a 'Disable_Controlled attribute when
	Expander_Active is False, because otherwise, we get errors about
	nonstatic expressions in pragma-Preelaborate generic packages.
	* restrict.ads: minor whitespace cleanup in comment

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-conhel.adb: Remove "use SAC;", because otherwise the compiler
	complains about use clauses in run-time units. Use "use type"
	instead.
	* a-btgbso.adb, a-btgbso.ads, a-cbdlli.adb, a-cbdlli.ads,
	* a-cbhama.adb, a-cbhama.ads, a-cbhase.adb, a-cbhase.ads,
	* a-cbmutr.adb, a-cbmutr.ads, a-cborma.adb, a-cborma.ads,
	* a-cborse.adb, a-cborse.ads, a-cdlili.adb, a-cdlili.ads,
	* a-chtgbk.adb, a-chtgbk.ads, a-chtgbo.adb, a-chtgbo.ads,
	* a-chtgke.adb, a-chtgke.ads, a-chtgop.adb, a-chtgop.ads,
	* a-cidlli.adb, a-cidlli.ads, a-cihama.adb, a-cihama.ads,
	* a-cihase.adb, a-cihase.ads, a-cimutr.adb, a-cimutr.ads,
	* a-ciorma.adb, a-ciorma.ads, a-ciormu.adb, a-ciormu.ads,
	* a-ciorse.adb, a-ciorse.ads, a-cobove.adb, a-cobove.ads,
	* a-cohama.adb, a-cohama.ads, a-cohase.adb, a-cohase.ads,
	* a-cohata.ads, a-coinve.adb, a-comutr.adb, a-comutr.ads,
	* a-convec.adb, a-coorma.adb, a-coorma.ads, a-coormu.adb,
	* a-coormu.ads, a-coorse.adb, a-coorse.ads, a-crbltr.ads,
	* a-crbtgk.adb, a-crbtgk.ads, a-crbtgo.adb, a-crbtgo.ads,
	* a-rbtgbk.adb, a-rbtgbk.ads, a-rbtgbo.adb, a-rbtgbo.ads,
	* a-rbtgso.adb, a-rbtgso.ads: Change all the predefined containers
	to share the tampering machinery in Ada.Containers.Helpers. This
	reduces the amount of duplicated code, and takes advantage of
	efficiency improvements in Helpers.
	Protect all run-time checks and supporting machinery with "if
	Checks" or "if T_Check", so this code can be suppressed with
	pragma Suppress or -gnatp.
	Add Pseudo_Reference and Get_Element_Access to remaining
	containers, so that the compiler can optimize "for ... of" loops.

From-SVN: r229041

1 files changed, 23 insertions, 78 deletions

diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb
index dda5f2c..87a2e1e 100644
--- a/gcc/ada/a-chtgop.adb
+++ b/gcc/ada/a-chtgop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2015, 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- --
@@ -34,6 +34,10 @@ with System;  use type System.Address;
 
 package body Ada.Containers.Hash_Tables.Generic_Operations is
 
+   pragma Warnings (Off, "variable ""Busy*"" is not referenced");
+   pragma Warnings (Off, "variable ""Lock*"" is not referenced");
+   --  See comment in Ada.Containers.Helpers
+
    type Buckets_Allocation is access all Buckets_Type;
    --  Used for allocation and deallocation (see New_Buckets and Free_Buckets).
    --  This is necessary because Buckets_Access has an empty storage pool.
@@ -130,28 +134,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       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;
-
+      Lock : With_Lock (Hash_Table.TC'Unrestricted_Access);
    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;
+      return Index (Buckets, Node);
    end Checked_Index;
 
    function Checked_Index
@@ -171,10 +156,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       Node  : Node_Access;
 
    begin
-      if HT.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
+      TC_Check (HT.TC);
 
       while HT.Length > 0 loop
          while HT.Buckets (Index) = null loop
@@ -217,7 +199,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          return;
       end if;
 
-      if HT.Length = 1 then
+      if Checks and then HT.Length = 1 then
          raise Program_Error with
            "attempt to delete node not in its proper hash bucket";
       end if;
@@ -225,7 +207,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       loop
          Curr := Next (Prev);
 
-         if Curr = null then
+         if Checks and then Curr = null then
             raise Program_Error with
               "attempt to delete node not in its proper hash bucket";
          end if;
@@ -256,7 +238,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       Curr : Node_Access;
 
    begin
-      if HT.Length = 0 then
+      if Checks and then HT.Length = 0 then
          raise Program_Error with
            "attempt to delete node from empty hashed container";
       end if;
@@ -264,7 +246,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       Indx := Checked_Index (HT, X);
       Prev := HT.Buckets (Indx);
 
-      if Prev = null then
+      if Checks and then Prev = null then
          raise Program_Error with
            "attempt to delete node from empty hash bucket";
       end if;
@@ -275,7 +257,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          return;
       end if;
 
-      if HT.Length = 1 then
+      if Checks and then HT.Length = 1 then
          raise Program_Error with
            "attempt to delete node not in its proper hash bucket";
       end if;
@@ -283,7 +265,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       loop
          Curr := Next (Prev);
 
-         if Curr = null then
+         if Checks and then Curr = null then
             raise Program_Error with
               "attempt to delete node not in its proper hash bucket";
          end if;
@@ -375,13 +357,11 @@ 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;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-      Result : Boolean;
+      Lock_L : With_Lock (L.TC'Unrestricted_Access);
+      Lock_R : With_Lock (R.TC'Unrestricted_Access);
 
       L_Index : Hash_Type;
       L_Node  : Node_Access;
@@ -410,23 +390,13 @@ 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
-            Result := False;
-            exit;
+            return False;
          end if;
 
          N := N - 1;
@@ -437,8 +407,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
             --  We have exhausted the nodes in this bucket
 
             if N = 0 then
-               Result := True;
-               exit;
+               return True;
             end if;
 
             --  Find the next bucket
@@ -450,24 +419,6 @@ 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;
 
    -----------------------
@@ -507,7 +458,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
 
       Count_Type'Base'Read (Stream, N);
 
-      if N < 0 then
+      if Checks and then N < 0 then
          raise Program_Error with "stream appears to be corrupt";
       end if;
 
@@ -600,10 +551,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          return;
       end if;
 
-      if Source.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
+      TC_Check (Source.TC);
 
       Clear (Target);
 
@@ -745,10 +693,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          end if;
       end if;
 
-      if HT.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
+      TC_Check (HT.TC);
 
       Rehash : declare
          Dst_Buckets : Buckets_Access := New_Buckets (Length => NN);