2005-06-14 Matthew Heaney <heaney@adacore.com>

	* a-swunha.ads, a-swunha.adb: Removed. Replaced by a-swuwha.ad[sb]
	* a-swuwha.ads, a-swuwha.adb: New files

	* a-szunha.ads, a-szunha.adb: Removed, replaced by a-szuzha.ad[sb]
	* a-szuzha.ads, a-szuzha.adb: New files.

	* a-rbtgso.adb, a-crbtgo.ads, a-crbtgo.adb, a-crbtgk.ads,
	a-crbtgk.adb, a-crbltr.ads, a-coorse.ads, a-coorse.adb, a-convec.ads,
	a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohata.ads, a-cohama.ads,
	a-cohama.adb, a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb,
	a-cidlli.ads, a-cidlli.adb, a-chtgop.ads, a-chtgop.adb, a-cdlili.ads,
	a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb,
	a-cohase.ads, a-ciorma.ads, a-coorma.ads, a-ciormu.ads, a-coormu.ads,
	a-swunha.adb, a-stunha.adb, a-ciorma.adb, a-coorma.adb, a-shcain.ads,
	a-shcain.adb, a-chtgke.ads, a-chtgke.adb, a-stwiha.ads, a-stwiha.adb,
	a-strhas.adb, a-stzhas.adb: synchronized to the latest version of the
	Ada 2005 RM.


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

1 files changed, 723 insertions, 347 deletions

diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb
index c98c58a3b21..77d11243d1c 100644
--- a/gcc/ada/a-convec.adb
+++ b/gcc/ada/a-convec.adb
@@ -2,11 +2,11 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---                          ADA.CONTAINERS.VECTORS                          --
+--                A D A . C O N T A I N E R S . V E C T O R S               --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2004 Free Software Foundation, Inc.            --
+--          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -67,7 +67,7 @@ package body Ada.Containers.Vectors is
                          new Elements_Type'(RE);
 
          begin
-            return (Controlled with Elements, Right.Last);
+            return (Controlled with Elements, Right.Last, 0, 0);
          end;
       end if;
 
@@ -80,28 +80,35 @@ package body Ada.Containers.Vectors is
                          new Elements_Type'(LE);
 
          begin
-            return (Controlled with Elements, Left.Last);
+            return (Controlled with Elements, Left.Last, 0, 0);
          end;
 
       end if;
 
       declare
-         Last_As_Int : constant Int'Base :=
+         Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
                          Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
 
-         Last : constant Index_Type := Index_Type (Last_As_Int);
+      begin
+         if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
 
-         LE : Elements_Type renames
-                Left.Elements (Index_Type'First .. Left.Last);
+         declare
+            Last : constant Index_Type := Index_Type (Last_As_Int);
 
-         RE : Elements_Type renames
-                Right.Elements (Index_Type'First .. Right.Last);
+            LE : Elements_Type renames
+                   Left.Elements (Index_Type'First .. Left.Last);
 
-         Elements : constant Elements_Access :=
+            RE : Elements_Type renames
+                   Right.Elements (Index_Type'First .. Right.Last);
+
+            Elements : constant Elements_Access :=
                          new Elements_Type'(LE & RE);
 
-      begin
-         return (Controlled with Elements, Last);
+         begin
+            return (Controlled with Elements, Last, 0, 0);
+         end;
       end;
    end "&";
 
@@ -118,25 +125,32 @@ package body Ada.Containers.Vectors is
                          new Elements_Subtype'(others => Right);
 
          begin
-            return (Controlled with Elements, Index_Type'First);
+            return (Controlled with Elements, Index_Type'First, 0, 0);
          end;
       end if;
 
       declare
-         Last_As_Int : constant Int'Base :=
+         Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
                          Int (Index_Type'First) + Int (LN);
 
-         Last : constant Index_Type := Index_Type (Last_As_Int);
+      begin
+         if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
 
-         LE : Elements_Type renames
-                Left.Elements (Index_Type'First .. Left.Last);
+         declare
+            Last : constant Index_Type := Index_Type (Last_As_Int);
 
-         subtype ET is Elements_Type (Index_Type'First .. Last);
+            LE : Elements_Type renames
+                   Left.Elements (Index_Type'First .. Left.Last);
 
-         Elements : constant Elements_Access := new ET'(LE & Right);
+            subtype ET is Elements_Type (Index_Type'First .. Last);
 
-      begin
-         return (Controlled with Elements, Last);
+            Elements : constant Elements_Access := new ET'(LE & Right);
+
+         begin
+            return (Controlled with Elements, Last, 0, 0);
+         end;
       end;
    end "&";
 
@@ -153,38 +167,51 @@ package body Ada.Containers.Vectors is
                          new Elements_Subtype'(others => Left);
 
          begin
-            return (Controlled with Elements, Index_Type'First);
+            return (Controlled with Elements, Index_Type'First, 0, 0);
          end;
       end if;
 
       declare
-         Last_As_Int : constant Int'Base :=
+         Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
                          Int (Index_Type'First) + Int (RN);
 
-         Last : constant Index_Type := Index_Type (Last_As_Int);
+      begin
+         if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
 
-         RE : Elements_Type renames
-                Right.Elements (Index_Type'First .. Right.Last);
+         declare
+            Last : constant Index_Type := Index_Type (Last_As_Int);
 
-         subtype ET is Elements_Type (Index_Type'First .. Last);
+            RE : Elements_Type renames
+                   Right.Elements (Index_Type'First .. Right.Last);
 
-         Elements : constant Elements_Access := new ET'(Left & RE);
+            subtype ET is Elements_Type (Index_Type'First .. Last);
 
-      begin
-         return (Controlled with Elements, Last);
+            Elements : constant Elements_Access := new ET'(Left & RE);
+
+         begin
+            return (Controlled with Elements, Last, 0, 0);
+         end;
       end;
    end "&";
 
    function "&" (Left, Right  : Element_Type) return Vector is
-      subtype IT is Index_Type'Base range
-        Index_Type'First .. Index_Type'Succ (Index_Type'First);
+   begin
+      if Index_Type'First >= Index_Type'Last then
+         raise Constraint_Error;
+      end if;
 
-      subtype ET is Elements_Type (IT);
+      declare
+         Last : constant Index_Type := Index_Type'First + 1;
 
-      Elements : constant Elements_Access := new ET'(Left, Right);
+         subtype ET is Elements_Type (Index_Type'First .. Last);
 
-   begin
-      return Vector'(Controlled with Elements, Elements'Last);
+         Elements : constant Elements_Access := new ET'(Left, Right);
+
+      begin
+         return (Controlled with Elements, Last, 0, 0);
+      end;
    end "&";
 
    ---------
@@ -216,25 +243,21 @@ package body Ada.Containers.Vectors is
 
    procedure Adjust (Container : in out Vector) is
    begin
-      if Container.Elements = null then
-         return;
-      end if;
-
-      if Container.Elements'Length = 0
-        or else Container.Last < Index_Type'First
-      then
+      if Container.Last = No_Index then
          Container.Elements := null;
          return;
       end if;
 
       declare
-         X : constant Elements_Access := Container.Elements;
-         L : constant Index_Type'Base := Container.Last;
-         E : Elements_Type renames X (Index_Type'First .. L);
+         E : constant Elements_Access := Container.Elements;
+         L : constant Index_Type := Container.Last;
+
       begin
          Container.Elements := null;
-         Container.Last := Index_Type'Pred (Index_Type'First);
-         Container.Elements := new Elements_Type'(E);
+         Container.Last := No_Index;
+         Container.Busy := 0;
+         Container.Lock := 0;
+         Container.Elements := new Elements_Type'(E (Index_Type'First .. L));
          Container.Last := L;
       end;
    end Adjust;
@@ -249,9 +272,13 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
+      if Container.Last = Index_Type'Last then
+         raise Constraint_Error;
+      end if;
+
       Insert
         (Container,
-         Index_Type'Succ (Container.Last),
+         Container.Last + 1,
          New_Item);
    end Append;
 
@@ -265,9 +292,13 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
+      if Container.Last = Index_Type'Last then
+         raise Constraint_Error;
+      end if;
+
       Insert
         (Container,
-         Index_Type'Succ (Container.Last),
+         Container.Last + 1,
          New_Item,
          Count);
    end Append;
@@ -322,7 +353,11 @@ package body Ada.Containers.Vectors is
 
    procedure Clear (Container : in out Vector) is
    begin
-      Container.Last := Index_Type'Pred (Index_Type'First);
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
+      Container.Last := No_Index;
    end Clear;
 
    --------------
@@ -347,39 +382,54 @@ package body Ada.Containers.Vectors is
       Count     : Count_Type := 1)
    is
    begin
-      if Count = 0 then
-         return;
+      if Index < Index_Type'First then
+         raise Constraint_Error;
       end if;
 
-      declare
-         subtype I_Subtype is Index_Type'Base range
-           Index_Type'First .. Container.Last;
+      if Index > Container.Last then
+         if Index > Container.Last + 1 then
+            raise Constraint_Error;
+         end if;
 
-         I : constant I_Subtype := Index;
-         --  TODO: not sure whether to relax this check ???
+         return;
+      end if;
 
-         I_As_Int : constant Int := Int (I);
+      if Count = 0 then
+         return;
+      end if;
 
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
+      declare
+         I_As_Int        : constant Int := Int (Index);
          Old_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);
 
          Count1 : constant Int'Base := Count_Type'Pos (Count);
          Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1;
-
-         N : constant Int'Base := Int'Min (Count1, Count2);
+         N      : constant Int'Base := Int'Min (Count1, Count2);
 
          J_As_Int : constant Int'Base := I_As_Int + N;
-         J        : constant Index_Type'Base := Index_Type'Base (J_As_Int);
 
-         E : Elements_Type renames Container.Elements.all;
+      begin
+         if J_As_Int > Old_Last_As_Int then
+            Container.Last := Index - 1;
 
-         New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
+         else
+            declare
+               J : constant Index_Type := Index_Type (J_As_Int);
+               E : Elements_Type renames Container.Elements.all;
 
-         New_Last : constant Extended_Index :=
-                      Extended_Index (New_Last_As_Int);
+               New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
+               New_Last        : constant Index_Type :=
+                                   Index_Type (New_Last_As_Int);
 
-      begin
-         E (I .. New_Last) := E (J .. Container.Last);
-         Container.Last := New_Last;
+            begin
+               E (Index .. New_Last) := E (J .. Container.Last);
+               Container.Last := New_Last;
+            end;
+         end if;
       end;
    end Delete;
 
@@ -389,19 +439,15 @@ package body Ada.Containers.Vectors is
       Count     : Count_Type := 1)
    is
    begin
-
-      if Position.Container /= null
-        and then Position.Container /=
-                   Vector_Access'(Container'Unchecked_Access)
-      then
-         raise Program_Error;
+      if Position.Container = null then
+         raise Constraint_Error;
       end if;
 
-      if Position.Container = null
+      if Position.Container /=
+           Vector_Access'(Container'Unchecked_Access)
         or else Position.Index > Container.Last
       then
-         Position := No_Element;
-         return;
+         raise Program_Error;
       end if;
 
       Delete (Container, Position.Index, Count);
@@ -449,14 +495,17 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      if Count >= Length (Container) then
-         Clear (Container);
-         return;
+      if Container.Busy > 0 then
+         raise Program_Error;
       end if;
 
-      Index := Int'Base (Container.Last) - Int'Base (Count) + 1;
+      Index := Int'Base (Container.Last) - Int'Base (Count);
 
-      Delete (Container, Index_Type'Base (Index), Count);
+      if Index < Index_Type'Pos (Index_Type'First) then
+         Container.Last := No_Index;
+      else
+         Container.Last := Index_Type (Index);
+      end if;
    end Delete_Last;
 
    -------------
@@ -467,14 +516,20 @@ package body Ada.Containers.Vectors is
      (Container : Vector;
       Index     : Index_Type) return Element_Type
    is
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Container.Last;
    begin
-      return Container.Elements (T'(Index));
+      if Index > Container.Last then
+         raise Constraint_Error;
+      end if;
+
+      return Container.Elements (Index);
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Container = null then
+         raise Constraint_Error;
+      end if;
+
       return Element (Position.Container.all, Position.Index);
    end Element;
 
@@ -485,8 +540,12 @@ package body Ada.Containers.Vectors is
    procedure Finalize (Container : in out Vector) is
       X : Elements_Access := Container.Elements;
    begin
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
       Container.Elements := null;
-      Container.Last := Index_Type'Pred (Index_Type'First);
+      Container.Last := No_Index;
       Free (X);
    end Finalize;
 
@@ -501,8 +560,9 @@ package body Ada.Containers.Vectors is
 
    begin
       if Position.Container /= null
-        and then Position.Container /=
-                   Vector_Access'(Container'Unchecked_Access)
+        and then (Position.Container /=
+                    Vector_Access'(Container'Unchecked_Access)
+                  or else Position.Index > Container.Last)
       then
          raise Program_Error;
       end if;
@@ -566,26 +626,112 @@ package body Ada.Containers.Vectors is
       return Index_Type'First;
    end First_Index;
 
-   ------------------
-   -- Generic_Sort --
-   ------------------
+   ---------------------
+   -- Generic_Sorting --
+   ---------------------
 
-   procedure Generic_Sort (Container : Vector)
-   is
-      procedure Sort is
-         new Generic_Array_Sort
-          (Index_Type   => Index_Type,
-           Element_Type => Element_Type,
-           Array_Type   => Elements_Type,
-           "<"          => "<");
+   package body Generic_Sorting is
 
-   begin
-      if Container.Elements = null then
-         return;
-      end if;
+      ---------------
+      -- Is_Sorted --
+      ---------------
+
+      function Is_Sorted (Container : Vector) return Boolean is
+      begin
+         if Container.Last <= Index_Type'First then
+            return True;
+         end if;
+
+         declare
+            E : Elements_Type renames Container.Elements.all;
+         begin
+            for I in Index_Type'First .. Container.Last - 1 loop
+               if E (I + 1) < E (I) then
+                  return False;
+               end if;
+            end loop;
+         end;
+
+         return True;
+      end Is_Sorted;
+
+      -----------
+      -- Merge --
+      -----------
 
-      Sort (Container.Elements (Index_Type'First .. Container.Last));
-   end Generic_Sort;
+      procedure Merge (Target, Source : in out Vector) is
+         I : Index_Type'Base := Target.Last;
+         J : Index_Type'Base;
+
+      begin
+         if Target.Last < Index_Type'First then
+            Move (Target => Target, Source => Source);
+            return;
+         end if;
+
+         if Target'Address = Source'Address then
+            return;
+         end if;
+
+         if Source.Last < Index_Type'First then
+            return;
+         end if;
+
+         if Source.Busy > 0 then
+            raise Program_Error;
+         end if;
+
+         Target.Set_Length (Length (Target) + Length (Source));
+
+         J := Target.Last;
+         while Source.Last >= Index_Type'First loop
+            if I < Index_Type'First then
+               Target.Elements (Index_Type'First .. J) :=
+                 Source.Elements (Index_Type'First .. Source.Last);
+
+               Source.Last := No_Index;
+               return;
+            end if;
+
+            if Source.Elements (Source.Last) < Target.Elements (I) then
+               Target.Elements (J) := Target.Elements (I);
+               I := I - 1;
+
+            else
+               Target.Elements (J) := Source.Elements (Source.Last);
+               Source.Last := Source.Last - 1;
+            end if;
+
+            J := J - 1;
+         end loop;
+      end Merge;
+
+      ----------
+      -- Sort --
+      ----------
+
+      procedure Sort (Container : in out Vector)
+      is
+         procedure Sort is
+            new Generic_Array_Sort
+             (Index_Type   => Index_Type,
+              Element_Type => Element_Type,
+              Array_Type   => Elements_Type,
+              "<"          => "<");
+
+      begin
+         if Container.Last <= Index_Type'First then
+            return;
+         end if;
+
+         if Container.Lock > 0 then
+            raise Program_Error;
+         end if;
+
+         Sort (Container.Elements (Index_Type'First .. Container.Last));
+      end Sort;
+
+   end Generic_Sorting;
 
    -----------------
    -- Has_Element --
@@ -610,40 +756,47 @@ package body Ada.Containers.Vectors is
       New_Item  : Element_Type;
       Count     : Count_Type := 1)
    is
-      Old_Last : constant Extended_Index := Container.Last;
-
-      Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
-
       N : constant Int := Count_Type'Pos (Count);
 
-      New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
+      New_Last_As_Int : Int'Base;
+      New_Last        : Index_Type;
 
-      New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
+      Dst : Elements_Access;
 
-      Index : Index_Type;
+   begin
+      if Before < Index_Type'First then
+         raise Constraint_Error;
+      end if;
 
-      Dst_Last : Index_Type;
-      Dst      : Elements_Access;
+      if Before > Container.Last
+        and then Before > Container.Last + 1
+      then
+         raise Constraint_Error;
+      end if;
 
-   begin
       if Count = 0 then
          return;
       end if;
 
       declare
-         subtype Before_Subtype is Index_Type'Base range
-           Index_Type'First .. Index_Type'Succ (Container.Last);
+         Old_Last : constant Extended_Index := Container.Last;
 
-         Old_First : constant Before_Subtype := Before;
+         Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
 
-         Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);
+      begin
+         New_Last_As_Int := Old_Last_As_Int + N;
 
-         New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
+         if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
 
-      begin
-         Index := Index_Type (New_First_As_Int);
+         New_Last := Index_Type (New_Last_As_Int);
       end;
 
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
       if Container.Elements = null then
          declare
             subtype Elements_Subtype is
@@ -660,8 +813,23 @@ package body Ada.Containers.Vectors is
          declare
             E : Elements_Type renames Container.Elements.all;
          begin
-            E (Index .. New_Last) := E (Before .. Container.Last);
-            E (Before .. Index_Type'Pred (Index)) := (others => New_Item);
+            if Before <= Container.Last then
+               declare
+                  Index_As_Int : constant Int'Base :=
+                                   Index_Type'Pos (Before) + N;
+
+                  Index : constant Index_Type := Index_Type (Index_As_Int);
+
+               begin
+                  E (Index .. New_Last) := E (Before .. Container.Last);
+
+                  E (Before .. Index_Type'Pred (Index)) :=
+                      (others => New_Item);
+               end;
+
+            else
+               E (Before .. New_Last) := (others => New_Item);
+            end if;
          end;
 
          Container.Last := New_Last;
@@ -669,35 +837,40 @@ package body Ada.Containers.Vectors is
       end if;
 
       declare
-         First : constant Int := Int (Index_Type'First);
-
+         First    : constant Int := Int (Index_Type'First);
          New_Size : constant Int'Base := New_Last_As_Int - First + 1;
-         Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
-
-         Size, Dst_Last_As_Int : Int'Base;
+         Size     : Int'Base := Int'Max (1, Container.Elements'Length);
 
       begin
-         if New_Size >= Max_Size / 2 then
-            Dst_Last := Index_Type'Last;
+         while Size < New_Size loop
+            if Size > Int'Last / 2 then
+               Size := Int'Last;
+               exit;
+            end if;
 
-         else
-            Size := Container.Elements'Length;
+            Size := 2 * Size;
+         end loop;
 
-            if Size = 0 then
-               Size := 1;
-            end if;
+         --  TODO: The following calculations aren't quite right, since
+         --  there will be overflow if Index_Type'Range is very large
+         --  (e.g. this package is instantiated with a 64-bit integer).
+         --  END TODO.
 
-            while Size < New_Size loop
-               Size := 2 * Size;
-            end loop;
+         declare
+            Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
+         begin
+            if Size > Max_Size then
+               Size := Max_Size;
+            end if;
+         end;
 
-            Dst_Last_As_Int := First + Size - 1;
-            Dst_Last := Index_Type (Dst_Last_As_Int);
-         end if;
+         declare
+            Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
+         begin
+            Dst := new Elements_Type (Index_Type'First .. Dst_Last);
+         end;
       end;
 
-      Dst := new Elements_Type (Index_Type'First .. Dst_Last);
-
       declare
          Src : Elements_Type renames Container.Elements.all;
 
@@ -705,12 +878,21 @@ package body Ada.Containers.Vectors is
          Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
            Src (Index_Type'First .. Index_Type'Pred (Before));
 
-         Dst (Before .. Index_Type'Pred (Index)) :=
-           (others => New_Item);
+         if Before <= Container.Last then
+            declare
+               Index_As_Int : constant Int'Base :=
+                                Index_Type'Pos (Before) + N;
 
-         Dst (Index .. New_Last) :=
-           Src (Before .. Container.Last);
+               Index : constant Index_Type := Index_Type (Index_As_Int);
 
+            begin
+               Dst (Before .. Index_Type'Pred (Index)) := (others => New_Item);
+               Dst (Index .. New_Last) := Src (Before .. Container.Last);
+            end;
+
+         else
+            Dst (Before .. New_Last) := (others => New_Item);
+         end if;
       exception
          when others =>
             Free (Dst);
@@ -734,6 +916,16 @@ package body Ada.Containers.Vectors is
       N : constant Count_Type := Length (New_Item);
 
    begin
+      if Before < Index_Type'First then
+         raise Constraint_Error;
+      end if;
+
+      if Before > Container.Last
+        and then Before > Container.Last + 1
+      then
+         raise Constraint_Error;
+      end if;
+
       if N = 0 then
          return;
       end if;
@@ -747,51 +939,56 @@ package body Ada.Containers.Vectors is
          Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
 
       begin
-         if Container'Address = New_Item'Address then
-            declare
-               subtype Src_Index_Subtype is Index_Type'Base range
-                 Index_Type'First .. Index_Type'Pred (Before);
+         if Container'Address /= New_Item'Address then
+            Container.Elements (Before .. Dst_Last) :=
+              New_Item.Elements (Index_Type'First .. New_Item.Last);
 
-               Src : Elements_Type renames
-                       Container.Elements (Src_Index_Subtype);
+            return;
+         end if;
 
-               Index_As_Int : constant Int'Base :=
-                                Int (Before) + Src'Length - 1;
+         declare
+            subtype Src_Index_Subtype is Index_Type'Base range
+              Index_Type'First .. Before - 1;
 
-               Index : constant Index_Type'Base :=
-                         Index_Type'Base (Index_As_Int);
+            Src : Elements_Type renames
+                    Container.Elements (Src_Index_Subtype);
 
-               Dst : Elements_Type renames
-                       Container.Elements (Before .. Index);
+            Index_As_Int : constant Int'Base :=
+                             Int (Before) + Src'Length - 1;
 
-            begin
-               Dst := Src;
-            end;
+            Index : constant Index_Type'Base :=
+                      Index_Type'Base (Index_As_Int);
 
-            declare
-               subtype Src_Index_Subtype is Index_Type'Base range
-                 Index_Type'Succ (Dst_Last) .. Container.Last;
+            Dst : Elements_Type renames
+                    Container.Elements (Before .. Index);
 
-               Src : Elements_Type renames
-                       Container.Elements (Src_Index_Subtype);
+         begin
+            Dst := Src;
+         end;
 
-               Index_As_Int : constant Int'Base :=
-                                Dst_Last_As_Int - Src'Length + 1;
+         if Dst_Last = Container.Last then
+            return;
+         end if;
 
-               Index : constant Index_Type'Base :=
-                         Index_Type'Base (Index_As_Int);
+         declare
+            subtype Src_Index_Subtype is Index_Type'Base range
+              Dst_Last + 1 .. Container.Last;
 
-               Dst : Elements_Type renames
-                       Container.Elements (Index .. Dst_Last);
+            Src : Elements_Type renames
+                    Container.Elements (Src_Index_Subtype);
 
-            begin
-               Dst := Src;
-            end;
+            Index_As_Int : constant Int'Base :=
+                             Dst_Last_As_Int - Src'Length + 1;
 
-         else
-            Container.Elements (Before .. Dst_Last) :=
-              New_Item.Elements (Index_Type'First .. New_Item.Last);
-         end if;
+            Index : constant Index_Type :=
+                      Index_Type (Index_As_Int);
+
+            Dst : Elements_Type renames
+                    Container.Elements (Index .. Dst_Last);
+
+         begin
+            Dst := Src;
+         end;
       end;
    end Insert;
 
@@ -816,7 +1013,12 @@ package body Ada.Containers.Vectors is
       if Before.Container = null
         or else Before.Index > Container.Last
       then
-         Index := Index_Type'Succ (Container.Last);
+         if Container.Last = Index_Type'Last then
+            raise Constraint_Error;
+         end if;
+
+         Index := Container.Last + 1;
+
       else
          Index := Before.Index;
       end if;
@@ -854,7 +1056,12 @@ package body Ada.Containers.Vectors is
       if Before.Container = null
         or else Before.Index > Container.Last
       then
-         Index := Index_Type'Succ (Container.Last);
+         if Container.Last = Index_Type'Last then
+            raise Constraint_Error;
+         end if;
+
+         Index := Container.Last + 1;
+
       else
          Index := Before.Index;
       end if;
@@ -886,7 +1093,12 @@ package body Ada.Containers.Vectors is
       if Before.Container = null
         or else Before.Index > Container.Last
       then
-         Index := Index_Type'Succ (Container.Last);
+         if Container.Last = Index_Type'Last then
+            raise Constraint_Error;
+         end if;
+
+         Index := Container.Last + 1;
+
       else
          Index := Before.Index;
       end if;
@@ -925,7 +1137,12 @@ package body Ada.Containers.Vectors is
       if Before.Container = null
         or else Before.Index > Container.Last
       then
-         Index := Index_Type'Succ (Container.Last);
+         if Container.Last = Index_Type'Last then
+            raise Constraint_Error;
+         end if;
+
+         Index := Container.Last + 1;
+
       else
          Index := Before.Index;
       end if;
@@ -944,40 +1161,47 @@ package body Ada.Containers.Vectors is
       Before    : Extended_Index;
       Count     : Count_Type := 1)
    is
-      Old_Last : constant Extended_Index := Container.Last;
-
-      Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
-
       N : constant Int := Count_Type'Pos (Count);
 
-      New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
+      New_Last_As_Int : Int'Base;
+      New_Last        : Index_Type;
 
-      New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
+      Dst : Elements_Access;
 
-      Index : Index_Type;
+   begin
+      if Before < Index_Type'First then
+         raise Constraint_Error;
+      end if;
 
-      Dst_Last : Index_Type;
-      Dst      : Elements_Access;
+      if Before > Container.Last
+        and then Before > Container.Last + 1
+      then
+         raise Constraint_Error;
+      end if;
 
-   begin
       if Count = 0 then
          return;
       end if;
 
       declare
-         subtype Before_Subtype is Index_Type'Base range
-           Index_Type'First .. Index_Type'Succ (Container.Last);
+         Old_Last : constant Extended_Index := Container.Last;
 
-         Old_First : constant Before_Subtype := Before;
+         Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
 
-         Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);
+      begin
+         New_Last_As_Int := Old_Last_As_Int + N;
 
-         New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
+         if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
 
-      begin
-         Index := Index_Type (New_First_As_Int);
+         New_Last := Index_Type (New_Last_As_Int);
       end;
 
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
       if Container.Elements = null then
          Container.Elements :=
            new Elements_Type (Index_Type'First .. New_Last);
@@ -990,7 +1214,17 @@ package body Ada.Containers.Vectors is
          declare
             E : Elements_Type renames Container.Elements.all;
          begin
-            E (Index .. New_Last) := E (Before .. Container.Last);
+            if Before <= Container.Last then
+               declare
+                  Index_As_Int : constant Int'Base :=
+                                   Index_Type'Pos (Before) + N;
+
+                  Index : constant Index_Type := Index_Type (Index_As_Int);
+
+               begin
+                  E (Index .. New_Last) := E (Before .. Container.Last);
+               end;
+            end if;
          end;
 
          Container.Last := New_Last;
@@ -998,35 +1232,40 @@ package body Ada.Containers.Vectors is
       end if;
 
       declare
-         First : constant Int := Int (Index_Type'First);
-
+         First    : constant Int := Int (Index_Type'First);
          New_Size : constant Int'Base := New_Last_As_Int - First + 1;
-         Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
-
-         Size, Dst_Last_As_Int : Int'Base;
+         Size     : Int'Base := Int'Max (1, Container.Elements'Length);
 
       begin
-         if New_Size >= Max_Size / 2 then
-            Dst_Last := Index_Type'Last;
+         while Size < New_Size loop
+            if Size > Int'Last / 2 then
+               Size := Int'Last;
+               exit;
+            end if;
 
-         else
-            Size := Container.Elements'Length;
+            Size := 2 * Size;
+         end loop;
 
-            if Size = 0 then
-               Size := 1;
-            end if;
+         --  TODO: The following calculations aren't quite right, since
+         --  there will be overflow if Index_Type'Range is very large
+         --  (e.g. this package is instantiated with a 64-bit integer).
+         --  END TODO.
 
-            while Size < New_Size loop
-               Size := 2 * Size;
-            end loop;
+         declare
+            Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
+         begin
+            if Size > Max_Size then
+               Size := Max_Size;
+            end if;
+         end;
 
-            Dst_Last_As_Int := First + Size - 1;
-            Dst_Last := Index_Type (Dst_Last_As_Int);
-         end if;
+         declare
+            Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
+         begin
+            Dst := new Elements_Type (Index_Type'First .. Dst_Last);
+         end;
       end;
 
-      Dst := new Elements_Type (Index_Type'First .. Dst_Last);
-
       declare
          Src : Elements_Type renames Container.Elements.all;
 
@@ -1034,9 +1273,17 @@ package body Ada.Containers.Vectors is
          Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
            Src (Index_Type'First .. Index_Type'Pred (Before));
 
-         Dst (Index .. New_Last) :=
-           Src (Before .. Container.Last);
+         if Before <= Container.Last then
+            declare
+               Index_As_Int : constant Int'Base :=
+                                Index_Type'Pos (Before) + N;
 
+               Index : constant Index_Type := Index_Type (Index_As_Int);
+
+            begin
+               Dst (Index .. New_Last) := Src (Before .. Container.Last);
+            end;
+         end if;
       exception
          when others =>
             Free (Dst);
@@ -1048,7 +1295,6 @@ package body Ada.Containers.Vectors is
       begin
          Container.Elements := Dst;
          Container.Last := New_Last;
-
          Free (X);
       end;
    end Insert_Space;
@@ -1083,7 +1329,12 @@ package body Ada.Containers.Vectors is
       if Before.Container = null
         or else Before.Index > Container.Last
       then
-         Index := Index_Type'Succ (Container.Last);
+         if Container.Last = Index_Type'Last then
+            raise Constraint_Error;
+         end if;
+
+         Index := Container.Last + 1;
+
       else
          Index := Before.Index;
       end if;
@@ -1110,10 +1361,25 @@ package body Ada.Containers.Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor))
    is
+      V : Vector renames Container'Unrestricted_Access.all;
+      B : Natural renames V.Busy;
+
    begin
-      for Indx in Index_Type'First .. Container.Last loop
-         Process (Cursor'(Container'Unchecked_Access, Indx));
-      end loop;
+
+      B := B + 1;
+
+      begin
+         for Indx in Index_Type'First .. Container.Last loop
+            Process (Cursor'(Container'Unchecked_Access, Indx));
+         end loop;
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+
+      B := B - 1;
+
    end Iterate;
 
    ----------
@@ -1155,7 +1421,12 @@ package body Ada.Containers.Vectors is
       L : constant Int := Int (Container.Last);
       F : constant Int := Int (Index_Type'First);
       N : constant Int'Base := L - F + 1;
+
    begin
+      if N > Count_Type'Pos (Count_Type'Last) then
+         raise Constraint_Error;
+      end if;
+
       return Count_Type (N);
    end Length;
 
@@ -1167,25 +1438,28 @@ package body Ada.Containers.Vectors is
      (Target : in out Vector;
       Source : in out Vector)
    is
-      X : Elements_Access := Target.Elements;
-
    begin
       if Target'Address = Source'Address then
          return;
       end if;
 
-      if Target.Last >= Index_Type'First then
-         raise Constraint_Error;
+      if Target.Busy > 0 then
+         raise Program_Error;
       end if;
 
-      Target.Elements := null;
-      Free (X);
+      if Source.Busy > 0 then
+         raise Program_Error;
+      end if;
 
-      Target.Elements := Source.Elements;
-      Target.Last := Source.Last;
+      declare
+         Target_Elements : constant Elements_Access := Target.Elements;
+      begin
+         Target.Elements := Source.Elements;
+         Source.Elements := Target_Elements;
+      end;
 
-      Source.Elements := null;
-      Source.Last := Index_Type'Pred (Index_Type'First);
+      Target.Last := Source.Last;
+      Source.Last := No_Index;
    end Move;
 
    ----------
@@ -1199,7 +1473,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Position.Index < Position.Container.Last then
-         return (Position.Container, Index_Type'Succ (Position.Index));
+         return (Position.Container, Position.Index + 1);
       end if;
 
       return No_Element;
@@ -1216,7 +1490,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Position.Index < Position.Container.Last then
-         Position.Index := Index_Type'Succ (Position.Index);
+         Position.Index := Position.Index + 1;
       else
          Position := No_Element;
       end if;
@@ -1254,7 +1528,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Position.Index > Index_Type'First then
-         Position.Index := Index_Type'Pred (Position.Index);
+         Position.Index := Position.Index - 1;
       else
          Position := No_Element;
       end if;
@@ -1267,7 +1541,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       if Position.Index > Index_Type'First then
-         return (Position.Container, Index_Type'Pred (Position.Index));
+         return (Position.Container, Position.Index - 1);
       end if;
 
       return No_Element;
@@ -1282,23 +1556,41 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type;
       Process   : not null access procedure (Element : Element_Type))
    is
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Container.Last;
+      V : Vector renames Container'Unrestricted_Access.all;
+      B : Natural renames V.Busy;
+      L : Natural renames V.Lock;
+
    begin
-      Process (Container.Elements (T'(Index)));
+      if Index > Container.Last then
+         raise Constraint_Error;
+      end if;
+
+      B := B + 1;
+      L := L + 1;
+
+      begin
+         Process (V.Elements (Index));
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      L := L - 1;
+      B := B - 1;
    end Query_Element;
 
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type))
    is
-      Container : Vector renames Position.Container.all;
-
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Container.Last;
-
    begin
-      Process (Container.Elements (T'(Position.Index)));
+      if Position.Container = null then
+         raise Constraint_Error;
+      end if;
+
+      Query_Element (Position.Container.all, Position.Index, Process);
    end Query_Element;
 
    ----------
@@ -1310,7 +1602,7 @@ package body Ada.Containers.Vectors is
       Container : out Vector)
    is
       Length : Count_Type'Base;
-      Last   : Index_Type'Base := Index_Type'Pred (Index_Type'First);
+      Last   : Index_Type'Base := No_Index;
 
    begin
       Clear (Container);
@@ -1322,7 +1614,7 @@ package body Ada.Containers.Vectors is
       end if;
 
       for J in Count_Type range 1 .. Length loop
-         Last := Index_Type'Succ (Last);
+         Last := Last + 1;
          Element_Type'Read (Stream, Container.Elements (Last));
          Container.Last := Last;
       end loop;
@@ -1337,17 +1629,25 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type;
       By        : Element_Type)
    is
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Container.Last;
    begin
-      Container.Elements (T'(Index)) := By;
+      if Index > Container.Last then
+         raise Constraint_Error;
+      end if;
+
+      if Container.Lock > 0 then
+         raise Program_Error;
+      end if;
+
+      Container.Elements (Index) := By;
    end Replace_Element;
 
    procedure Replace_Element (Position : Cursor; By : Element_Type) is
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Position.Container.Last;
    begin
-      Position.Container.Elements (T'(Position.Index)) := By;
+      if Position.Container = null then
+         raise Constraint_Error;
+      end if;
+
+      Replace_Element (Position.Container.all, Position.Index, By);
    end Replace_Element;
 
    ----------------------
@@ -1371,6 +1671,10 @@ package body Ada.Containers.Vectors is
             end;
 
          elsif N < Container.Elements'Length then
+            if Container.Busy > 0 then
+               raise Program_Error;
+            end if;
+
             declare
                subtype Array_Index_Subtype is Index_Type'Base range
                  Index_Type'First .. Container.Last;
@@ -1397,13 +1701,19 @@ package body Ada.Containers.Vectors is
             Last_As_Int : constant Int'Base :=
                             Int (Index_Type'First) + Int (Capacity) - 1;
 
-            Last : constant Index_Type := Index_Type (Last_As_Int);
+         begin
+            if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+               raise Constraint_Error;
+            end if;
 
-            subtype Array_Subtype is
-              Elements_Type (Index_Type'First .. Last);
+            declare
+               Last : constant Index_Type := Index_Type (Last_As_Int);
 
-         begin
-            Container.Elements := new Array_Subtype;
+               subtype Array_Subtype is
+                 Elements_Type (Index_Type'First .. Last);
+            begin
+               Container.Elements := new Array_Subtype;
+            end;
          end;
 
          return;
@@ -1411,6 +1721,10 @@ package body Ada.Containers.Vectors is
 
       if Capacity <= N then
          if N < Container.Elements'Length then
+            if Container.Busy > 0 then
+               raise Program_Error;
+            end if;
+
             declare
                subtype Array_Index_Subtype is Index_Type'Base range
                  Index_Type'First .. Container.Last;
@@ -1437,39 +1751,50 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
       declare
          Last_As_Int : constant Int'Base :=
                          Int (Index_Type'First) + Int (Capacity) - 1;
 
-         Last : constant Index_Type := Index_Type (Last_As_Int);
-
-         subtype Array_Subtype is
-           Elements_Type (Index_Type'First .. Last);
-
-         E : Elements_Access := new Array_Subtype;
-
       begin
+         if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
+
          declare
-            Src : Elements_Type renames
-                    Container.Elements (Index_Type'First .. Container.Last);
+            Last : constant Index_Type := Index_Type (Last_As_Int);
+
+            subtype Array_Subtype is
+              Elements_Type (Index_Type'First .. Last);
 
-            Tgt : Elements_Type renames
-                    E (Index_Type'First .. Container.Last);
+            E : Elements_Access := new Array_Subtype;
 
          begin
-            Tgt := Src;
+            declare
+               Src : Elements_Type renames
+                       Container.Elements (Index_Type'First .. Container.Last);
 
-         exception
-            when others =>
-               Free (E);
-               raise;
-         end;
+               Tgt : Elements_Type renames
+                       E (Index_Type'First .. Container.Last);
 
-         declare
-            X : Elements_Access := Container.Elements;
-         begin
-            Container.Elements := E;
-            Free (X);
+            begin
+               Tgt := Src;
+
+            exception
+               when others =>
+                  Free (E);
+                  raise;
+            end;
+
+            declare
+               X : Elements_Access := Container.Elements;
+            begin
+               Container.Elements := E;
+               Free (X);
+            end;
          end;
       end;
    end Reserve_Capacity;
@@ -1545,10 +1870,25 @@ package body Ada.Containers.Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor))
    is
+      V : Vector renames Container'Unrestricted_Access.all;
+      B : Natural renames V.Busy;
+
    begin
-      for Indx in reverse Index_Type'First .. Container.Last loop
-         Process (Cursor'(Container'Unchecked_Access, Indx));
-      end loop;
+
+      B := B + 1;
+
+      begin
+         for Indx in reverse Index_Type'First .. Container.Last loop
+            Process (Cursor'(Container'Unchecked_Access, Indx));
+         end loop;
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+
+      B := B - 1;
+
    end Reverse_Iterate;
 
    ----------------
@@ -1557,23 +1897,23 @@ package body Ada.Containers.Vectors is
 
    procedure Set_Length (Container : in out Vector; Length : Count_Type) is
    begin
-      if Length = 0 then
-         Clear (Container);
+      if Length = Vectors.Length (Container) then
          return;
       end if;
 
+      if Container.Busy > 0 then
+         raise Program_Error;
+      end if;
+
+      if Length > Capacity (Container) then
+         Reserve_Capacity (Container, Capacity => Length);
+      end if;
+
       declare
          Last_As_Int : constant Int'Base :=
                          Int (Index_Type'First) + Int (Length) - 1;
-
-         Last        : constant Index_Type := Index_Type (Last_As_Int);
-
       begin
-         if Length > Capacity (Container) then
-            Reserve_Capacity (Container, Capacity => Length);
-         end if;
-
-         Container.Last := Last;
+         Container.Last := Index_Type'Base (Last_As_Int);
       end;
    end Set_Length;
 
@@ -1581,44 +1921,47 @@ package body Ada.Containers.Vectors is
    -- Swap --
    ----------
 
-   procedure Swap
-     (Container : Vector;
-      I, J      : Index_Type)
-   is
+   procedure Swap (Container : Vector; I, J : Index_Type) is
+   begin
+      if I > Container.Last
+        or else J > Container.Last
+      then
+         raise Constraint_Error;
+      end if;
 
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Container.Last;
+      if I = J then
+         return;
+      end if;
 
-      EI : constant Element_Type := Container.Elements (T'(I));
+      if Container.Lock > 0 then
+         raise Program_Error;
+      end if;
 
-   begin
+      declare
+         EI : Element_Type renames Container.Elements (I);
+         EJ : Element_Type renames Container.Elements (J);
 
-      Container.Elements (T'(I)) := Container.Elements (T'(J));
-      Container.Elements (T'(J)) := EI;
+         EI_Copy : constant Element_Type := EI;
 
+      begin
+         EI := EJ;
+         EJ := EI_Copy;
+      end;
    end Swap;
 
    procedure Swap (I, J : Cursor) is
+   begin
+      if I.Container = null
+        or else J.Container = null
+      then
+         raise Constraint_Error;
+      end if;
 
-      --  NOTE: The behavior has been liberalized here to
-      --  allow I and J to designate different containers.
-      --  TODO: Probably this is supposed to raise P_E ???
-
-      subtype TI is Index_Type'Base range
-        Index_Type'First .. I.Container.Last;
-
-      EI : Element_Type renames I.Container.Elements (TI'(I.Index));
-
-      EI_Copy : constant Element_Type := EI;
-
-      subtype TJ is Index_Type'Base range
-        Index_Type'First .. J.Container.Last;
-
-      EJ : Element_Type renames J.Container.Elements (TJ'(J.Index));
+      if I.Container /= J.Container then
+         raise Program_Error;
+      end if;
 
-   begin
-      EI := EJ;
-      EJ := EI_Copy;
+      Swap (I.Container.all, I.Index, J.Index);
    end Swap;
 
    ---------------
@@ -1667,11 +2010,18 @@ package body Ada.Containers.Vectors is
       declare
          First       : constant Int := Int (Index_Type'First);
          Last_As_Int : constant Int'Base := First + Int (Length) - 1;
-         Last        : constant Index_Type := Index_Type (Last_As_Int);
-         Elements    : constant Elements_Access :=
-                         new Elements_Type (Index_Type'First .. Last);
+         Last        : Index_Type;
+         Elements    : Elements_Access;
+
       begin
-         return (Controlled with Elements, Last);
+         if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
+
+         Last := Index_Type (Last_As_Int);
+         Elements := new Elements_Type (Index_Type'First .. Last);
+
+         return (Controlled with Elements, Last, 0, 0);
       end;
    end To_Vector;
 
@@ -1687,12 +2037,18 @@ package body Ada.Containers.Vectors is
       declare
          First       : constant Int := Int (Index_Type'First);
          Last_As_Int : constant Int'Base := First + Int (Length) - 1;
-         Last        : constant Index_Type := Index_Type (Last_As_Int);
-         Elements    : constant Elements_Access :=
-                         new Elements_Type'
-                                   (Index_Type'First .. Last => New_Item);
+         Last        : Index_Type;
+         Elements    : Elements_Access;
+
       begin
-         return (Controlled with Elements, Last);
+         if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+            raise Constraint_Error;
+         end if;
+
+         Last := Index_Type (Last_As_Int);
+         Elements := new Elements_Type'(Index_Type'First .. Last => New_Item);
+
+         return (Controlled with Elements, Last, 0, 0);
       end;
    end To_Vector;
 
@@ -1705,20 +2061,41 @@ package body Ada.Containers.Vectors is
       Index     : Index_Type;
       Process   : not null access procedure (Element : in out Element_Type))
    is
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Container.Last;
+      V : Vector renames Container'Unrestricted_Access.all;
+      B : Natural renames V.Busy;
+      L : Natural renames V.Lock;
+
    begin
-      Process (Container.Elements (T'(Index)));
+      if Index > Container.Last then
+         raise Constraint_Error;
+      end if;
+
+      B := B + 1;
+      L := L + 1;
+
+      begin
+         Process (V.Elements (Index));
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      L := L - 1;
+      B := B - 1;
    end Update_Element;
 
    procedure Update_Element
      (Position : Cursor;
       Process  : not null access procedure (Element : in out Element_Type))
    is
-      subtype T is Index_Type'Base range
-        Index_Type'First .. Position.Container.Last;
    begin
-      Process (Position.Container.Elements (T'(Position.Index)));
+      if Position.Container = null then
+         raise Constraint_Error;
+      end if;
+
+      Update_Element (Position.Container.all, Position.Index, Process);
    end Update_Element;
 
    -----------
@@ -1738,4 +2115,3 @@ package body Ada.Containers.Vectors is
    end Write;
 
 end Ada.Containers.Vectors;
-