2013-04-11 Robert Dewar <dewar@adacore.com>

	* stand.ads: Minor reformatting.

2013-04-11  Matthew Heaney  <heaney@adacore.com>

	* a-convec.adb, a-coinve.adb, a-cobove.adb ("="): Increment lock
	counts before entering loop.
	(Find, Find_Index): Ditto.
	(Is_Sorted, Merge, Sort): Ditto.
	(Reverse_Find, Reverse_Find_Index): Ditto.



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

1 files changed, 289 insertions, 87 deletions

diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index 8ca958f0b71..01755cfd80f 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2012, 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- --
@@ -112,8 +112,8 @@ package body Ada.Containers.Bounded_Vectors is
          raise Constraint_Error with "new length is out of range";
       end if;
 
-      --  It is now safe compute the length of the new vector, without fear of
-      --  overflow.
+      --  It is now safe to compute the length of the new vector, without fear
+      --  of overflow.
 
       N := LN + RN;
 
@@ -122,6 +122,7 @@ package body Ada.Containers.Bounded_Vectors is
       --  Count_Type'Base as the type for intermediate values.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.
@@ -150,6 +151,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of length.
@@ -280,6 +282,14 @@ package body Ada.Containers.Bounded_Vectors is
    ---------
 
    overriding function "=" (Left, Right : Vector) return Boolean is
+      BL : Natural renames Left'Unrestricted_Access.Busy;
+      LL : Natural renames Left'Unrestricted_Access.Lock;
+
+      BR : Natural renames Right'Unrestricted_Access.Busy;
+      LR : Natural renames Right'Unrestricted_Access.Lock;
+
+      Result : Boolean;
+
    begin
       if Left'Address = Right'Address then
          return True;
@@ -289,13 +299,40 @@ package body Ada.Containers.Bounded_Vectors is
          return False;
       end if;
 
+      --  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;
+
+      Result := True;
       for J in Count_Type range 1 .. Left.Length loop
          if Left.Elements (J) /= Right.Elements (J) then
-            return False;
+            Result := False;
+            exit;
          end if;
       end loop;
 
-      return True;
+      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 "=";
 
    ------------
@@ -543,7 +580,6 @@ package body Ada.Containers.Bounded_Vectors is
 
       if Count_Type'Base'Last >= Index_Type'Pos (Index_Type'Base'Last) then
          Count2 := Count_Type'Base (Old_Last) - Count_Type'Base (Index) + 1;
-
       else
          Count2 := Count_Type'Base (Old_Last - Index + 1);
       end if;
@@ -567,7 +603,6 @@ package body Ada.Containers.Bounded_Vectors is
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
          Off := Count_Type'Base (Index - Index_Type'First);
          New_Last := Old_Last - Index_Type'Base (Count);
-
       else
          Off := Count_Type'Base (Index) - Count_Type'Base (Index_Type'First);
          New_Last := Index_Type'Base (Count_Type'Base (Old_Last) - Count);
@@ -579,7 +614,6 @@ package body Ada.Containers.Bounded_Vectors is
       declare
          EA  : Elements_Array renames Container.Elements;
          Idx : constant Count_Type := EA'First + Off;
-
       begin
          EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len);
          Container.Last := New_Last;
@@ -621,14 +655,14 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Count = 0 then
          return;
-      end if;
 
-      if Count >= Length (Container) then
+      elsif Count >= Length (Container) then
          Clear (Container);
          return;
-      end if;
 
-      Delete (Container, Index_Type'First, Count);
+      else
+         Delete (Container, Index_Type'First, Count);
+      end if;
    end Delete_First;
 
    -----------------
@@ -738,13 +772,42 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
       end if;
 
-      for J in Position.Index .. Container.Last loop
-         if Container.Elements (To_Array_Index (J)) = Item then
-            return (Container'Unrestricted_Access, J);
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      declare
+         B : Natural renames Container'Unrestricted_Access.Busy;
+         L : Natural renames Container'Unrestricted_Access.Lock;
+
+         Result : Index_Type'Base;
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Result := No_Index;
+         for J in Position.Index .. Container.Last loop
+            if Container.Elements (To_Array_Index (J)) = Item then
+               Result := J;
+               exit;
+            end if;
+         end loop;
+
+         B := B - 1;
+         L := L - 1;
+
+         if Result = No_Index then
+            return No_Element;
+         else
+            return Cursor'(Container'Unrestricted_Access, Result);
          end if;
-      end loop;
 
-      return No_Element;
+      exception
+         when others =>
+            B := B - 1;
+            L := L - 1;
+            raise;
+      end;
    end Find;
 
    ----------------
@@ -756,14 +819,36 @@ package body Ada.Containers.Bounded_Vectors is
       Item      : Element_Type;
       Index     : Index_Type := Index_Type'First) return Extended_Index
    is
+      B : Natural renames Container'Unrestricted_Access.Busy;
+      L : Natural renames Container'Unrestricted_Access.Lock;
+
+      Result : Index_Type'Base;
+
    begin
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B := B + 1;
+      L := L + 1;
+
+      Result := No_Index;
       for Indx in Index .. Container.Last loop
          if Container.Elements (To_Array_Index (Indx)) = Item then
-            return Indx;
+            Result := Indx;
+            exit;
          end if;
       end loop;
 
-      return No_Index;
+      B := B - 1;
+      L := L - 1;
+
+      return Result;
+
+   exception
+      when others =>
+         B := B - 1;
+         L := L - 1;
+         raise;
    end Find_Index;
 
    -----------
@@ -841,17 +926,40 @@ package body Ada.Containers.Bounded_Vectors is
             return True;
          end if;
 
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
          declare
             EA : Elements_Array renames Container.Elements;
+
+            B : Natural renames Container'Unrestricted_Access.Busy;
+            L : Natural renames Container'Unrestricted_Access.Lock;
+
+            Result : Boolean;
+
          begin
+            B := B + 1;
+            L := L + 1;
+
+            Result := True;
             for J in 1 .. Container.Length - 1 loop
                if EA (J + 1) < EA (J) then
-                  return False;
+                  Result := False;
+                  exit;
                end if;
             end loop;
-         end;
 
-         return True;
+            B := B - 1;
+            L := L - 1;
+
+            return Result;
+
+         exception
+            when others =>
+               B := B - 1;
+               L := L - 1;
+               raise;
+         end;
       end Is_Sorted;
 
       -----------
@@ -862,7 +970,6 @@ package body Ada.Containers.Bounded_Vectors is
          I, J : Count_Type;
 
       begin
-
          --  The semantics of Merge changed slightly per AI05-0021. It was
          --  originally the case that if Target and Source denoted the same
          --  container object, then the GNAT implementation of Merge did
@@ -893,21 +1000,35 @@ package body Ada.Containers.Bounded_Vectors is
          I := Target.Length;
          Target.Set_Length (I + Source.Length);
 
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
          declare
             TA : Elements_Array renames Target.Elements;
             SA : Elements_Array renames Source.Elements;
 
+            TB : Natural renames Target.Busy;
+            TL : Natural renames Target.Lock;
+
+            SB : Natural renames Source.Busy;
+            SL : Natural renames Source.Lock;
+
          begin
+            TB := TB + 1;
+            TL := TL + 1;
+
+            SB := SB + 1;
+            SL := SL + 1;
+
             J := Target.Length;
             while not Source.Is_Empty loop
                pragma Assert (Source.Length <= 1
-                                or else not (SA (Source.Length) <
-                                             SA (Source.Length - 1)));
+                 or else not (SA (Source.Length) < SA (Source.Length - 1)));
 
                if I = 0 then
                   TA (1 .. J) := SA (1 .. Source.Length);
                   Source.Last := No_Index;
-                  return;
+                  exit;
                end if;
 
                pragma Assert (I <= 1
@@ -924,6 +1045,22 @@ package body Ada.Containers.Bounded_Vectors is
 
                J := J - 1;
             end loop;
+
+            TB := TB - 1;
+            TL := TL - 1;
+
+            SB := SB - 1;
+            SL := SL - 1;
+
+         exception
+            when others =>
+               TB := TB - 1;
+               TL := TL - 1;
+
+               SB := SB - 1;
+               SL := SL - 1;
+
+               raise;
          end;
       end Merge;
 
@@ -960,7 +1097,28 @@ package body Ada.Containers.Bounded_Vectors is
               "attempt to tamper with cursors (vector is busy)";
          end if;
 
-         Sort (Container.Elements (1 .. Container.Length));
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         declare
+            B : Natural renames Container.Busy;
+            L : Natural renames Container.Lock;
+
+         begin
+            B := B + 1;
+            L := L + 1;
+
+            Sort (Container.Elements (1 .. Container.Length));
+
+            B := B - 1;
+            L := L - 1;
+
+         exception
+            when others =>
+               B := B - 1;
+               L := L - 1;
+               raise;
+         end;
       end Sort;
 
    end Generic_Sorting;
@@ -1056,10 +1214,12 @@ package body Ada.Containers.Bounded_Vectors is
       --  acceptable, then we compute the new last index from that.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We have to handle the case when there might be more values in the
          --  range of Index_Type than in the range of Count_Type.
 
          if Index_Type'First <= 0 then
+
             --  We know that No_Index (the same as Index_Type'First - 1) is
             --  less than 0, so it is safe to compute the following sum without
             --  fear of overflow.
@@ -1067,6 +1227,7 @@ package body Ada.Containers.Bounded_Vectors is
             Index := No_Index + Index_Type'Base (Count_Type'Last);
 
             if Index <= Index_Type'Last then
+
                --  We have determined that range of Index_Type has at least as
                --  many values as in Count_Type, so Count_Type'Last is the
                --  maximum number of items that are allowed.
@@ -1091,6 +1252,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  We know that No_Index (the same as Index_Type'First - 1) is less
          --  than 0, so it is safe to compute the following sum without fear of
          --  overflow.
@@ -1098,6 +1260,7 @@ package body Ada.Containers.Bounded_Vectors is
          J := Count_Type'Base (No_Index) + Count_Type'Last;
 
          if J <= Count_Type'Base (Index_Type'Last) then
+
             --  We have determined that range of Index_Type has at least as
             --  many values as in Count_Type, so Count_Type'Last is the maximum
             --  number of items that are allowed.
@@ -1151,6 +1314,7 @@ package body Ada.Containers.Bounded_Vectors is
       J := To_Array_Index (Before);
 
       if Before > Container.Last then
+
          --  The new items are being appended to the vector, so no
          --  sliding of existing elements is required.
 
@@ -1508,10 +1672,12 @@ package body Ada.Containers.Bounded_Vectors is
       --  acceptable, then we compute the new last index from that.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We have to handle the case when there might be more values in the
          --  range of Index_Type than in the range of Count_Type.
 
          if Index_Type'First <= 0 then
+
             --  We know that No_Index (the same as Index_Type'First - 1) is
             --  less than 0, so it is safe to compute the following sum without
             --  fear of overflow.
@@ -1519,6 +1685,7 @@ package body Ada.Containers.Bounded_Vectors is
             Index := No_Index + Index_Type'Base (Count_Type'Last);
 
             if Index <= Index_Type'Last then
+
                --  We have determined that range of Index_Type has at least as
                --  many values as in Count_Type, so Count_Type'Last is the
                --  maximum number of items that are allowed.
@@ -1543,6 +1710,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  We know that No_Index (the same as Index_Type'First - 1) is less
          --  than 0, so it is safe to compute the following sum without fear of
          --  overflow.
@@ -1550,6 +1718,7 @@ package body Ada.Containers.Bounded_Vectors is
          J := Count_Type'Base (No_Index) + Count_Type'Last;
 
          if J <= Count_Type'Base (Index_Type'Last) then
+
             --  We have determined that range of Index_Type has at least as
             --  many values as in Count_Type, so Count_Type'Last is the maximum
             --  number of items that are allowed.
@@ -1608,6 +1777,7 @@ package body Ada.Containers.Bounded_Vectors is
       --  unused storage for the new items.
 
       if Before <= Container.Last then
+
          --  The space is being inserted before some existing elements,
          --  so we must slide the existing elements up to their new home.
 
@@ -1927,36 +2097,30 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Position.Container = null then
          return No_Element;
-      end if;
-
-      if Position.Index < Position.Container.Last then
+      elsif Position.Index < Position.Container.Last then
          return (Position.Container, Position.Index + 1);
+      else
+         return No_Element;
       end if;
-
-      return No_Element;
    end Next;
 
    function Next (Object : Iterator; Position : Cursor) return Cursor is
    begin
       if Position.Container = null then
          return No_Element;
-      end if;
-
-      if Position.Container /= Object.Container then
+      elsif Position.Container /= Object.Container then
          raise Program_Error with
            "Position cursor of Next designates wrong vector";
+      else
+         return Next (Position);
       end if;
-
-      return Next (Position);
    end Next;
 
    procedure Next (Position : in out Cursor) is
    begin
       if Position.Container = null then
          return;
-      end if;
-
-      if Position.Index < Position.Container.Last then
+      elsif Position.Index < Position.Container.Last then
          Position.Index := Position.Index + 1;
       else
          Position := No_Element;
@@ -1992,9 +2156,7 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Position.Container = null then
          return;
-      end if;
-
-      if Position.Index > Index_Type'First then
+      elsif Position.Index > Index_Type'First then
          Position.Index := Position.Index - 1;
       else
          Position := No_Element;
@@ -2005,27 +2167,23 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Position.Container = null then
          return No_Element;
-      end if;
-
-      if Position.Index > Index_Type'First then
+      elsif Position.Index > Index_Type'First then
          return (Position.Container, Position.Index - 1);
+      else
+         return No_Element;
       end if;
-
-      return No_Element;
    end Previous;
 
    function Previous (Object : Iterator; Position : Cursor) return Cursor is
    begin
       if Position.Container = null then
          return No_Element;
-      end if;
-
-      if Position.Container /= Object.Container then
+      elsif Position.Container /= Object.Container then
          raise Program_Error with
            "Position cursor of Previous designates wrong vector";
+      else
+         return Previous (Position);
       end if;
-
-      return Previous (Position);
    end Previous;
 
    -------------------
@@ -2069,9 +2227,9 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
+      else
+         Query_Element (Position.Container.all, Position.Index, Process);
       end if;
-
-      Query_Element (Position.Container.all, Position.Index, Process);
    end Query_Element;
 
    ----------
@@ -2146,9 +2304,9 @@ package body Ada.Containers.Bounded_Vectors is
 
       declare
          A : Elements_Array renames Container.Elements;
-         I : constant Count_Type := To_Array_Index (Position.Index);
+         J : constant Count_Type := To_Array_Index (Position.Index);
       begin
-         return (Element => A (I)'Access);
+         return (Element => A (J)'Access);
       end;
    end Reference;
 
@@ -2163,9 +2321,9 @@ package body Ada.Containers.Bounded_Vectors is
 
       declare
          A : Elements_Array renames Container.Elements;
-         I : constant Count_Type := To_Array_Index (Index);
+         J : constant Count_Type := To_Array_Index (Index);
       begin
-         return (Element => A (I)'Access);
+         return (Element => A (J)'Access);
       end;
    end Reference;
 
@@ -2181,14 +2339,12 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
-      end if;
-
-      if Container.Lock > 0 then
+      elsif Container.Lock > 0 then
          raise Program_Error with
            "attempt to tamper with elements (vector is locked)";
+      else
+         Container.Elements (To_Array_Index (Index)) := New_Item;
       end if;
-
-      Container.Elements (To_Array_Index (Index)) := New_Item;
    end Replace_Element;
 
    procedure Replace_Element
@@ -2199,22 +2355,20 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
-      end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
+      elsif Position.Container /= Container'Unrestricted_Access then
          raise Program_Error with "Position cursor denotes wrong container";
-      end if;
 
-      if Position.Index > Container.Last then
+      elsif Position.Index > Container.Last then
          raise Constraint_Error with "Position cursor is out of range";
-      end if;
 
-      if Container.Lock > 0 then
+      elsif Container.Lock > 0 then
          raise Program_Error with
            "attempt to tamper with elements (vector is locked)";
-      end if;
 
-      Container.Elements (To_Array_Index (Position.Index)) := New_Item;
+      else
+         Container.Elements (To_Array_Index (Position.Index)) := New_Item;
+      end if;
    end Replace_Element;
 
    ----------------------
@@ -2300,13 +2454,41 @@ package body Ada.Containers.Bounded_Vectors is
          then Container.Last
          else Position.Index);
 
-      for Indx in reverse Index_Type'First .. Last loop
-         if Container.Elements (To_Array_Index (Indx)) = Item then
-            return (Container'Unrestricted_Access, Indx);
-         end if;
-      end loop;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      declare
+         B : Natural renames Container'Unrestricted_Access.Busy;
+         L : Natural renames Container'Unrestricted_Access.Lock;
+
+         Result : Index_Type'Base;
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Result := No_Index;
+         for Indx in reverse Index_Type'First .. Last loop
+            if Container.Elements (To_Array_Index (Indx)) = Item then
+               Result := Indx;
+               exit;
+            end if;
+         end loop;
+
+         B := B - 1;
+         L := L - 1;
 
-      return No_Element;
+         if Result = No_Index then
+            return No_Element;
+         else
+            return Cursor'(Container'Unrestricted_Access, Result);
+         end if;
+      exception
+         when others =>
+            B := B - 1;
+            L := L - 1;
+            raise;
+      end;
    end Reverse_Find;
 
    ------------------------
@@ -2318,17 +2500,39 @@ package body Ada.Containers.Bounded_Vectors is
       Item      : Element_Type;
       Index     : Index_Type := Index_Type'Last) return Extended_Index
    is
+      B : Natural renames Container'Unrestricted_Access.Busy;
+      L : Natural renames Container'Unrestricted_Access.Lock;
+
       Last : constant Index_Type'Base :=
         Index_Type'Min (Container.Last, Index);
 
+      Result : Index_Type'Base;
+
    begin
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B := B + 1;
+      L := L + 1;
+
+      Result := No_Index;
       for Indx in reverse Index_Type'First .. Last loop
          if Container.Elements (To_Array_Index (Indx)) = Item then
-            return Indx;
+            Result := Indx;
+            exit;
          end if;
       end loop;
 
-      return No_Index;
+      B := B - 1;
+      L := L - 1;
+
+      return Result;
+
+   exception
+      when others =>
+         B := B - 1;
+         L := L - 1;
+         raise;
    end Reverse_Find_Index;
 
    ---------------------
@@ -2375,10 +2579,8 @@ package body Ada.Containers.Bounded_Vectors is
 
       if Count >= 0 then
          Container.Delete_Last (Count);
-
       elsif Container.Last >= Index_Type'Last then
          raise Constraint_Error with "vector is already at its maximum length";
-
       else
          Container.Insert_Space (Container.Last + 1, -Count);
       end if;
@@ -2451,11 +2653,11 @@ package body Ada.Containers.Bounded_Vectors is
       --  hence we also know that
       --    Index - Index_Type'First >= 0
 
-      --  The issue is that even though 0 is guaranteed to be a value
-      --  in the type Index_Type'Base, there's no guarantee that the
-      --  difference is a value in that type. To prevent overflow we
-      --  use the wider of Count_Type'Base and Index_Type'Base to
-      --  perform intermediate calculations.
+      --  The issue is that even though 0 is guaranteed to be a value in
+      --  the type Index_Type'Base, there's no guarantee that the difference
+      --  is a value in that type. To prevent overflow we use the wider
+      --  of Count_Type'Base and Index_Type'Base to perform intermediate
+      --  calculations.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
          Offset := Count_Type'Base (Index - Index_Type'First);