diff options
Diffstat (limited to 'gcc/ada/a-coinve.adb')
| -rw-r--r-- | gcc/ada/a-coinve.adb | 408 |
1 files changed, 226 insertions, 182 deletions
diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index bccd95145f8..8233a4e9b90 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -59,22 +59,23 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - RE : Elements_Type renames - Right.Elements (Index_Type'First .. Right.Last); + RE : Elements_Array renames + Right.Elements.EA (Index_Type'First .. Right.Last); Elements : Elements_Access := - new Elements_Type (RE'Range); + new Elements_Type (Right.Last); begin - for I in Elements'Range loop + for I in Elements.EA'Range loop begin if RE (I) /= null then - Elements (I) := new Element_Type'(RE (I).all); + Elements.EA (I) := new Element_Type'(RE (I).all); end if; + exception when others => for J in Index_Type'First .. I - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -89,22 +90,23 @@ package body Ada.Containers.Indefinite_Vectors is if RN = 0 then declare - LE : Elements_Type renames - Left.Elements (Index_Type'First .. Left.Last); + LE : Elements_Array renames + Left.Elements.EA (Index_Type'First .. Left.Last); Elements : Elements_Access := - new Elements_Type (LE'Range); + new Elements_Type (Left.Last); begin - for I in Elements'Range loop + for I in Elements.EA'Range loop begin if LE (I) /= null then - Elements (I) := new Element_Type'(LE (I).all); + Elements.EA (I) := new Element_Type'(LE (I).all); end if; + exception when others => for J in Index_Type'First .. I - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -134,14 +136,13 @@ package body Ada.Containers.Indefinite_Vectors is declare Last : constant Index_Type := Index_Type (Last_As_Int); - LE : Elements_Type renames - Left.Elements (Index_Type'First .. Left.Last); + LE : Elements_Array renames + Left.Elements.EA (Index_Type'First .. Left.Last); - RE : Elements_Type renames - Right.Elements (Index_Type'First .. Right.Last); + RE : Elements_Array renames + Right.Elements.EA (Index_Type'First .. Right.Last); - Elements : Elements_Access := - new Elements_Type (Index_Type'First .. Last); + Elements : Elements_Access := new Elements_Type (Last); I : Index_Type'Base := No_Index; @@ -151,12 +152,13 @@ package body Ada.Containers.Indefinite_Vectors is begin if LE (LI) /= null then - Elements (I) := new Element_Type'(LE (LI).all); + Elements.EA (I) := new Element_Type'(LE (LI).all); end if; + exception when others => for J in Index_Type'First .. I - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -169,12 +171,13 @@ package body Ada.Containers.Indefinite_Vectors is begin if RE (RI) /= null then - Elements (I) := new Element_Type'(RE (RI).all); + Elements.EA (I) := new Element_Type'(RE (RI).all); end if; + exception when others => for J in Index_Type'First .. I - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -193,14 +196,11 @@ package body Ada.Containers.Indefinite_Vectors is begin if LN = 0 then declare - subtype Elements_Subtype is - Elements_Type (Index_Type'First .. Index_Type'First); - - Elements : Elements_Access := new Elements_Subtype; + Elements : Elements_Access := new Elements_Type (Index_Type'First); begin begin - Elements (Elements'First) := new Element_Type'(Right); + Elements.EA (Index_Type'First) := new Element_Type'(Right); exception when others => Free (Elements); @@ -228,22 +228,23 @@ package body Ada.Containers.Indefinite_Vectors is declare Last : constant Index_Type := Index_Type (Last_As_Int); - LE : Elements_Type renames - Left.Elements (Index_Type'First .. Left.Last); + LE : Elements_Array renames + Left.Elements.EA (Index_Type'First .. Left.Last); Elements : Elements_Access := - new Elements_Type (Index_Type'First .. Last); + new Elements_Type (Last); begin for I in LE'Range loop begin if LE (I) /= null then - Elements (I) := new Element_Type'(LE (I).all); + Elements.EA (I) := new Element_Type'(LE (I).all); end if; + exception when others => for J in Index_Type'First .. I - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -252,11 +253,12 @@ package body Ada.Containers.Indefinite_Vectors is end loop; begin - Elements (Elements'Last) := new Element_Type'(Right); + Elements.EA (Last) := new Element_Type'(Right); + exception when others => - for J in Index_Type'First .. Elements'Last - 1 loop - Free (Elements (J)); + for J in Index_Type'First .. Last - 1 loop + Free (Elements.EA (J)); end loop; Free (Elements); @@ -274,14 +276,11 @@ package body Ada.Containers.Indefinite_Vectors is begin if RN = 0 then declare - subtype Elements_Subtype is - Elements_Type (Index_Type'First .. Index_Type'First); - - Elements : Elements_Access := new Elements_Subtype; + Elements : Elements_Access := new Elements_Type (Index_Type'First); begin begin - Elements (Elements'First) := new Element_Type'(Left); + Elements.EA (Index_Type'First) := new Element_Type'(Left); exception when others => Free (Elements); @@ -309,17 +308,17 @@ package body Ada.Containers.Indefinite_Vectors is declare Last : constant Index_Type := Index_Type (Last_As_Int); - RE : Elements_Type renames - Right.Elements (Index_Type'First .. Right.Last); + RE : Elements_Array renames + Right.Elements.EA (Index_Type'First .. Right.Last); Elements : Elements_Access := - new Elements_Type (Index_Type'First .. Last); + new Elements_Type (Last); I : Index_Type'Base := Index_Type'First; begin begin - Elements (I) := new Element_Type'(Left); + Elements.EA (I) := new Element_Type'(Left); exception when others => Free (Elements); @@ -331,12 +330,13 @@ package body Ada.Containers.Indefinite_Vectors is begin if RE (RI) /= null then - Elements (I) := new Element_Type'(RE (RI).all); + Elements.EA (I) := new Element_Type'(RE (RI).all); end if; + exception when others => for J in Index_Type'First .. I - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -356,15 +356,12 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - Last : constant Index_Type := Index_Type'First + 1; - - subtype ET is Elements_Type (Index_Type'First .. Last); - - Elements : Elements_Access := new ET; + Last : constant Index_Type := Index_Type'First + 1; + Elements : Elements_Access := new Elements_Type (Last); begin begin - Elements (Elements'First) := new Element_Type'(Left); + Elements.EA (Index_Type'First) := new Element_Type'(Left); exception when others => Free (Elements); @@ -372,15 +369,15 @@ package body Ada.Containers.Indefinite_Vectors is end; begin - Elements (Elements'Last) := new Element_Type'(Right); + Elements.EA (Last) := new Element_Type'(Right); exception when others => - Free (Elements (Elements'First)); + Free (Elements.EA (Index_Type'First)); Free (Elements); raise; end; - return (Controlled with Elements, Elements'Last, 0, 0); + return (Controlled with Elements, Last, 0, 0); end; end "&"; @@ -399,15 +396,15 @@ package body Ada.Containers.Indefinite_Vectors is end if; for J in Index_Type'First .. Left.Last loop - if Left.Elements (J) = null then - if Right.Elements (J) /= null then + if Left.Elements.EA (J) = null then + if Right.Elements.EA (J) /= null then return False; end if; - elsif Right.Elements (J) = null then + elsif Right.Elements.EA (J) = null then return False; - elsif Left.Elements (J).all /= Right.Elements (J).all then + elsif Left.Elements.EA (J).all /= Right.Elements.EA (J).all then return False; end if; end loop; @@ -427,8 +424,9 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - E : Elements_Type renames Container.Elements.all; L : constant Index_Type := Container.Last; + E : Elements_Array renames + Container.Elements.EA (Index_Type'First .. L); begin Container.Elements := null; @@ -436,11 +434,11 @@ package body Ada.Containers.Indefinite_Vectors is Container.Busy := 0; Container.Lock := 0; - Container.Elements := new Elements_Type (Index_Type'First .. L); + Container.Elements := new Elements_Type (L); - for I in Container.Elements'Range loop + for I in E'Range loop if E (I) /= null then - Container.Elements (I) := new Element_Type'(E (I).all); + Container.Elements.EA (I) := new Element_Type'(E (I).all); end if; Container.Last := I; @@ -499,7 +497,7 @@ package body Ada.Containers.Indefinite_Vectors is return 0; end if; - return Container.Elements'Length; + return Container.Elements.EA'Length; end Capacity; ----------- @@ -515,9 +513,9 @@ package body Ada.Containers.Indefinite_Vectors is while Container.Last >= Index_Type'First loop declare - X : Element_Access := Container.Elements (Container.Last); + X : Element_Access := Container.Elements.EA (Container.Last); begin - Container.Elements (Container.Last) := null; + Container.Elements.EA (Container.Last) := null; Container.Last := Container.Last - 1; Free (X); end; @@ -576,7 +574,7 @@ package body Ada.Containers.Indefinite_Vectors is N : constant Int'Base := Int'Min (Count1, Count2); J_As_Int : constant Int'Base := Index_As_Int + N; - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin if J_As_Int > Old_Last_As_Int then @@ -637,7 +635,7 @@ package body Ada.Containers.Indefinite_Vectors is Delete (Container, Position.Index, Count); - Position := No_Element; -- See comment in a-convec.adb + Position := No_Element; end Delete; ------------------ @@ -684,7 +682,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin for Indx in 1 .. Count_Type'Min (Count, N) loop @@ -715,7 +713,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - EA : constant Element_Access := Container.Elements (Index); + EA : constant Element_Access := Container.Elements.EA (Index); begin if EA = null then @@ -732,7 +730,21 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "Position cursor has no element"; end if; - return Element (Position.Container.all, Position.Index); + if Position.Index > Position.Container.Last then + raise Constraint_Error with "Position cursor is out of range"; + end if; + + declare + EA : constant Element_Access := + Position.Container.Elements.EA (Position.Index); + + begin + if EA = null then + raise Constraint_Error with "element is empty"; + end if; + + return EA.all; + end; end Element; -------------- @@ -772,8 +784,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; for J in Position.Index .. Container.Last loop - if Container.Elements (J) /= null - and then Container.Elements (J).all = Item + if Container.Elements.EA (J) /= null + and then Container.Elements.EA (J).all = Item then return (Container'Unchecked_Access, J); end if; @@ -793,8 +805,8 @@ package body Ada.Containers.Indefinite_Vectors is is begin for Indx in Index .. Container.Last loop - if Container.Elements (Indx) /= null - and then Container.Elements (Indx).all = Item + if Container.Elements.EA (Indx) /= null + and then Container.Elements.EA (Indx).all = Item then return Indx; end if; @@ -822,7 +834,21 @@ package body Ada.Containers.Indefinite_Vectors is function First_Element (Container : Vector) return Element_Type is begin - return Element (Container, Index_Type'First); + if Container.Last = No_Index then + raise Constraint_Error with "Container is empty"; + end if; + + declare + EA : constant Element_Access := + Container.Elements.EA (Index_Type'First); + + begin + if EA = null then + raise Constraint_Error with "first element is empty"; + end if; + + return EA.all; + end; end First_Element; ----------------- @@ -874,7 +900,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin for I in Index_Type'First .. Container.Last - 1 loop if Is_Less (E (I + 1), E (I)) then @@ -891,8 +917,7 @@ package body Ada.Containers.Indefinite_Vectors is ----------- procedure Merge (Target, Source : in out Vector) is - I : Index_Type'Base := Target.Last; - J : Index_Type'Base; + I, J : Index_Type'Base; begin if Target.Last < Index_Type'First then @@ -913,23 +938,24 @@ package body Ada.Containers.Indefinite_Vectors is "attempt to tamper with elements (vector is busy)"; end if; + I := Target.Last; -- original value (before Set_Length) Target.Set_Length (Length (Target) + Length (Source)); - J := Target.Last; + J := Target.Last; -- new value (after Set_Length) while Source.Last >= Index_Type'First loop pragma Assert (Source.Last <= Index_Type'First or else not (Is_Less - (Source.Elements (Source.Last), - Source.Elements (Source.Last - 1)))); + (Source.Elements.EA (Source.Last), + Source.Elements.EA (Source.Last - 1)))); if I < Index_Type'First then declare - Src : Elements_Type renames - Source.Elements (Index_Type'First .. Source.Last); + Src : Elements_Array renames + Source.Elements.EA (Index_Type'First .. Source.Last); begin - Target.Elements (Index_Type'First .. J) := Src; + Target.Elements.EA (Index_Type'First .. J) := Src; Src := (others => null); end; @@ -940,21 +966,21 @@ package body Ada.Containers.Indefinite_Vectors is pragma Assert (I <= Index_Type'First or else not (Is_Less - (Target.Elements (I), - Target.Elements (I - 1)))); + (Target.Elements.EA (I), + Target.Elements.EA (I - 1)))); declare - Src : Element_Access renames Source.Elements (Source.Last); - Tgt : Element_Access renames Target.Elements (I); + Src : Element_Access renames Source.Elements.EA (Source.Last); + Tgt : Element_Access renames Target.Elements.EA (I); begin if Is_Less (Src, Tgt) then - Target.Elements (J) := Tgt; + Target.Elements.EA (J) := Tgt; Tgt := null; I := I - 1; else - Target.Elements (J) := Src; + Target.Elements.EA (J) := Src; Src := null; Source.Last := Source.Last - 1; end if; @@ -974,7 +1000,7 @@ package body Ada.Containers.Indefinite_Vectors is new Generic_Array_Sort (Index_Type => Index_Type, Element_Type => Element_Access, - Array_Type => Elements_Type, + Array_Type => Elements_Array, "<" => Is_Less); -- Start of processing for Sort @@ -989,7 +1015,7 @@ package body Ada.Containers.Indefinite_Vectors is "attempt to tamper with cursors (vector is locked)"; end if; - Sort (Container.Elements (Index_Type'First .. Container.Last)); + Sort (Container.Elements.EA (Index_Type'First .. Container.Last)); end Sort; end Generic_Sorting; @@ -1073,22 +1099,20 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Elements = null then - Container.Elements := - new Elements_Type (Index_Type'First .. New_Last); - + Container.Elements := new Elements_Type (New_Last); Container.Last := No_Index; - for J in Container.Elements'Range loop - Container.Elements (J) := new Element_Type'(New_Item); + for J in Container.Elements.EA'Range loop + Container.Elements.EA (J) := new Element_Type'(New_Item); Container.Last := J; end loop; return; end if; - if New_Last <= Container.Elements'Last then + if New_Last <= Container.Elements.Last then declare - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin if Before <= Container.Last then @@ -1131,7 +1155,7 @@ package body Ada.Containers.Indefinite_Vectors is C, CC : UInt; begin - C := UInt'Max (1, Container.Elements'Length); + C := UInt'Max (1, Container.Elements.EA'Length); -- ??? while C < New_Length loop if C > UInt'Last / 2 then C := UInt'Last; @@ -1163,7 +1187,7 @@ package body Ada.Containers.Indefinite_Vectors is Index_Type (First + UInt'Pos (C) - Int'(1)); begin - Dst := new Elements_Type (Index_Type'First .. Dst_Last); + Dst := new Elements_Type (Dst_Last); end; end; @@ -1177,17 +1201,17 @@ package body Ada.Containers.Indefinite_Vectors is Src : Elements_Access := Container.Elements; begin - Dst (Index_Type'First .. Before - 1) := - Src (Index_Type'First .. Before - 1); + Dst.EA (Index_Type'First .. Before - 1) := + Src.EA (Index_Type'First .. Before - 1); - Dst (Index .. New_Last) := Src (Before .. Container.Last); + Dst.EA (Index .. New_Last) := Src.EA (Before .. Container.Last); Container.Elements := Dst; Container.Last := New_Last; Free (Src); for J in Before .. Index - 1 loop - Dst (J) := new Element_Type'(New_Item); + Dst.EA (J) := new Element_Type'(New_Item); end loop; end; @@ -1196,14 +1220,14 @@ package body Ada.Containers.Indefinite_Vectors is Src : Elements_Access := Container.Elements; begin - Dst (Index_Type'First .. Container.Last) := - Src (Index_Type'First .. Container.Last); + Dst.EA (Index_Type'First .. Container.Last) := + Src.EA (Index_Type'First .. Container.Last); Container.Elements := Dst; Free (Src); for J in Before .. New_Last loop - Dst (J) := new Element_Type'(New_Item); + Dst.EA (J) := new Element_Type'(New_Item); Container.Last := J; end loop; end; @@ -1242,16 +1266,19 @@ package body Ada.Containers.Indefinite_Vectors is Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int); - Dst : Elements_Type renames - Container.Elements (Before .. Dst_Last); + Dst : Elements_Array renames + Container.Elements.EA (Before .. Dst_Last); Dst_Index : Index_Type'Base := Before - 1; begin if Container'Address /= New_Item'Address then declare - Src : Elements_Type renames - New_Item.Elements (Index_Type'First .. New_Item.Last); + subtype Src_Index_Subtype is Index_Type'Base range + Index_Type'First .. New_Item.Last; + + Src : Elements_Array renames + New_Item.Elements.EA (Src_Index_Subtype); begin for Src_Index in Src'Range loop @@ -1270,8 +1297,8 @@ package body Ada.Containers.Indefinite_Vectors is subtype Src_Index_Subtype is Index_Type'Base range Index_Type'First .. Before - 1; - Src : Elements_Type renames - Container.Elements (Src_Index_Subtype); + Src : Elements_Array renames + Container.Elements.EA (Src_Index_Subtype); begin for Src_Index in Src'Range loop @@ -1291,8 +1318,8 @@ package body Ada.Containers.Indefinite_Vectors is subtype Src_Index_Subtype is Index_Type'Base range Dst_Last + 1 .. Container.Last; - Src : Elements_Type renames - Container.Elements (Src_Index_Subtype); + Src : Elements_Array renames + Container.Elements.EA (Src_Index_Subtype); begin for Src_Index in Src'Range loop @@ -1535,16 +1562,14 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Elements = null then - Container.Elements := - new Elements_Type (Index_Type'First .. New_Last); - + Container.Elements := new Elements_Type (New_Last); Container.Last := New_Last; return; end if; - if New_Last <= Container.Elements'Last then + if New_Last <= Container.Elements.Last then declare - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin if Before <= Container.Last then @@ -1569,7 +1594,7 @@ package body Ada.Containers.Indefinite_Vectors is C, CC : UInt; begin - C := UInt'Max (1, Container.Elements'Length); + C := UInt'Max (1, Container.Elements.EA'Length); -- ??? while C < New_Length loop if C > UInt'Last / 2 then C := UInt'Last; @@ -1601,7 +1626,7 @@ package body Ada.Containers.Indefinite_Vectors is Index_Type (First + UInt'Pos (C) - 1); begin - Dst := new Elements_Type (Index_Type'First .. Dst_Last); + Dst := new Elements_Type (Dst_Last); end; end; @@ -1617,15 +1642,15 @@ package body Ada.Containers.Indefinite_Vectors is Index : constant Index_Type := Index_Type (Index_As_Int); begin - Dst (Index_Type'First .. Before - 1) := - Src (Index_Type'First .. Before - 1); + Dst.EA (Index_Type'First .. Before - 1) := + Src.EA (Index_Type'First .. Before - 1); - Dst (Index .. New_Last) := Src (Before .. Container.Last); + Dst.EA (Index .. New_Last) := Src.EA (Before .. Container.Last); end; else - Dst (Index_Type'First .. Container.Last) := - Src (Index_Type'First .. Container.Last); + Dst.EA (Index_Type'First .. Container.Last) := + Src.EA (Index_Type'First .. Container.Last); end if; Container.Elements := Dst; @@ -1735,7 +1760,21 @@ package body Ada.Containers.Indefinite_Vectors is function Last_Element (Container : Vector) return Element_Type is begin - return Element (Container, Container.Last); + if Container.Last = No_Index then + raise Constraint_Error with "Container is empty"; + end if; + + declare + EA : constant Element_Access := + Container.Elements.EA (Container.Last); + + begin + if EA = null then + raise Constraint_Error with "last element is empty"; + end if; + + return EA.all; + end; end Last_Element; ---------------- @@ -1894,7 +1933,7 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "Index is out of range"; end if; - if V.Elements (Index) = null then + if V.Elements.EA (Index) = null then raise Constraint_Error with "element is null"; end if; @@ -1902,7 +1941,7 @@ package body Ada.Containers.Indefinite_Vectors is L := L + 1; begin - Process (V.Elements (Index).all); + Process (V.Elements.EA (Index).all); exception when others => L := L - 1; @@ -1954,7 +1993,7 @@ package body Ada.Containers.Indefinite_Vectors is Boolean'Read (Stream, B); if B then - Container.Elements (Last) := + Container.Elements.EA (Last) := new Element_Type'(Element_Type'Input (Stream)); end if; @@ -1990,9 +2029,9 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - X : Element_Access := Container.Elements (Index); + X : Element_Access := Container.Elements.EA (Index); begin - Container.Elements (Index) := new Element_Type'(New_Item); + Container.Elements.EA (Index) := new Element_Type'(New_Item); Free (X); end; end Replace_Element; @@ -2011,7 +2050,21 @@ package body Ada.Containers.Indefinite_Vectors is raise Program_Error with "Position cursor denotes wrong container"; end if; - Replace_Element (Container, Position.Index, New_Item); + if Position.Index > Container.Last then + raise Constraint_Error with "Position cursor is out of range"; + end if; + + if Container.Lock > 0 then + raise Program_Error with + "attempt to tamper with cursors (vector is locked)"; + end if; + + declare + X : Element_Access := Container.Elements.EA (Position.Index); + begin + Container.Elements.EA (Position.Index) := new Element_Type'(New_Item); + Free (X); + end; end Replace_Element; ---------------------- @@ -2034,7 +2087,7 @@ package body Ada.Containers.Indefinite_Vectors is Free (X); end; - elsif N < Container.Elements'Length then + elsif N < Container.Elements.EA'Length then if Container.Busy > 0 then raise Program_Error with "attempt to tamper with elements (vector is busy)"; @@ -2044,16 +2097,13 @@ package body Ada.Containers.Indefinite_Vectors is subtype Array_Index_Subtype is Index_Type'Base range Index_Type'First .. Container.Last; - Src : Elements_Type renames - Container.Elements (Array_Index_Subtype); - - subtype Array_Subtype is - Elements_Type (Array_Index_Subtype); + Src : Elements_Array renames + Container.Elements.EA (Array_Index_Subtype); X : Elements_Access := Container.Elements; begin - Container.Elements := new Array_Subtype'(Src); + Container.Elements := new Elements_Type'(Container.Last, Src); Free (X); end; end if; @@ -2074,11 +2124,8 @@ package body Ada.Containers.Indefinite_Vectors is declare Last : constant Index_Type := Index_Type (Last_As_Int); - subtype Array_Subtype is - Elements_Type (Index_Type'First .. Last); - begin - Container.Elements := new Array_Subtype; + Container.Elements := new Elements_Type (Last); end; end; @@ -2086,7 +2133,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Capacity <= N then - if N < Container.Elements'Length then + if N < Container.Elements.EA'Length then if Container.Busy > 0 then raise Program_Error with "attempt to tamper with elements (vector is busy)"; @@ -2096,16 +2143,13 @@ package body Ada.Containers.Indefinite_Vectors is subtype Array_Index_Subtype is Index_Type'Base range Index_Type'First .. Container.Last; - Src : Elements_Type renames - Container.Elements (Array_Index_Subtype); - - subtype Array_Subtype is - Elements_Type (Array_Index_Subtype); + Src : Elements_Array renames + Container.Elements.EA (Array_Index_Subtype); X : Elements_Access := Container.Elements; begin - Container.Elements := new Array_Subtype'(Src); + Container.Elements := new Elements_Type'(Container.Last, Src); Free (X); end; end if; @@ -2113,7 +2157,7 @@ package body Ada.Containers.Indefinite_Vectors is return; end if; - if Capacity = Container.Elements'Length then + if Capacity = Container.Elements.EA'Length then return; end if; @@ -2133,21 +2177,20 @@ package body Ada.Containers.Indefinite_Vectors is declare Last : constant Index_Type := Index_Type (Last_As_Int); + X : Elements_Access := Container.Elements; - subtype Array_Subtype is - Elements_Type (Index_Type'First .. Last); - - X : Elements_Access := Container.Elements; + subtype Index_Subtype is Index_Type'Base range + Index_Type'First .. Container.Last; begin - Container.Elements := new Array_Subtype; + Container.Elements := new Elements_Type (Last); declare - Src : Elements_Type renames - X (Index_Type'First .. Container.Last); + Src : Elements_Array renames + X.EA (Index_Subtype); - Tgt : Elements_Type renames - Container.Elements (Index_Type'First .. Container.Last); + Tgt : Elements_Array renames + Container.Elements.EA (Index_Subtype); begin Tgt := Src; @@ -2176,7 +2219,7 @@ package body Ada.Containers.Indefinite_Vectors is declare I : Index_Type; J : Index_Type; - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin I := Index_Type'First; @@ -2223,8 +2266,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; for Indx in reverse Index_Type'First .. Last loop - if Container.Elements (Indx) /= null - and then Container.Elements (Indx).all = Item + if Container.Elements.EA (Indx) /= null + and then Container.Elements.EA (Indx).all = Item then return (Container'Unchecked_Access, Indx); end if; @@ -2252,8 +2295,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; for Indx in reverse Index_Type'First .. Last loop - if Container.Elements (Indx) /= null - and then Container.Elements (Indx).all = Item + if Container.Elements.EA (Indx) /= null + and then Container.Elements.EA (Indx).all = Item then return Indx; end if; @@ -2313,10 +2356,10 @@ package body Ada.Containers.Indefinite_Vectors is for Index in 1 .. N - Length loop declare J : constant Index_Type := Container.Last; - X : Element_Access := Container.Elements (J); + X : Element_Access := Container.Elements.EA (J); begin - Container.Elements (J) := null; + Container.Elements.EA (J) := null; Container.Last := J - 1; Free (X); end; @@ -2365,8 +2408,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - EI : Element_Access renames Container.Elements (I); - EJ : Element_Access renames Container.Elements (J); + EI : Element_Access renames Container.Elements.EA (I); + EJ : Element_Access renames Container.Elements.EA (J); EI_Copy : constant Element_Access := EI; @@ -2455,7 +2498,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; Last := Index_Type (Last_As_Int); - Elements := new Elements_Type (Index_Type'First .. Last); + Elements := new Elements_Type (Last); return (Controlled with Elements, Last, 0, 0); end; @@ -2482,20 +2525,21 @@ package body Ada.Containers.Indefinite_Vectors is end if; Last := Index_Type (Last_As_Int); - Elements := new Elements_Type (Index_Type'First .. Last); + Elements := new Elements_Type (Last); Last := Index_Type'First; begin loop - Elements (Last) := new Element_Type'(New_Item); - exit when Last = Elements'Last; + Elements.EA (Last) := new Element_Type'(New_Item); + exit when Last = Elements.Last; Last := Last + 1; end loop; + exception when others => for J in Index_Type'First .. Last - 1 loop - Free (Elements (J)); + Free (Elements.EA (J)); end loop; Free (Elements); @@ -2523,7 +2567,7 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "Index is out of range"; end if; - if Container.Elements (Index) = null then + if Container.Elements.EA (Index) = null then raise Constraint_Error with "element is null"; end if; @@ -2531,7 +2575,7 @@ package body Ada.Containers.Indefinite_Vectors is L := L + 1; begin - Process (Container.Elements (Index).all); + Process (Container.Elements.EA (Index).all); exception when others => L := L - 1; @@ -2578,7 +2622,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - E : Elements_Type renames Container.Elements.all; + E : Elements_Array renames Container.Elements.EA; begin for Indx in Index_Type'First .. Container.Last loop |