diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-02-17 16:08:48 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-02-17 16:08:48 +0000 |
commit | fe2a35e06d88ed2e4ca7b2bd226879f0e61b19f8 (patch) | |
tree | e3840316266dbd9e7ac56d6ad9624ab50cdb8b7a /gcc/ada/a-coinve.adb | |
parent | 3e8aa64033c2bdec68b43ec5e58acb2cb9688be0 (diff) | |
download | gcc-fe2a35e06d88ed2e4ca7b2bd226879f0e61b19f8.tar.gz |
2006-02-17 Matthew Heaney <heaney@adacore.com>
* a-convec.ads, a-convec.adb:
(operator "&"): handle potential overflow for large index types
(Insert): removed Contraint_Error when using large index types
(Insert_Space): removed Constraint_Error for large index types
(Length): moved constraint check from Length to Insert
* a-coinve.ads, a-coinve.adb: Stream attribute procedures are declared
as not null access.
Explicit raise statements now include an exception message.
(operator "&"): handle potential overflow for large index types
(Insert): removed Contraint_Error when using large index types
(Insert_Space): removed Constraint_Error for large index types
(Length): moved constraint check from Length to Insert
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111197 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/a-coinve.adb')
-rw-r--r-- | gcc/ada/a-coinve.adb | 391 |
1 files changed, 241 insertions, 150 deletions
diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 2252f78017a..121ee3f9788 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -40,6 +40,7 @@ with System; use type System.Address; package body Ada.Containers.Indefinite_Vectors is type Int is range System.Min_Int .. System.Max_Int; + type UInt is mod System.Max_Binary_Modulus; procedure Free is new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access); @@ -120,12 +121,18 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - Last_As_Int : constant Int'Base := -- TODO: handle overflow - Int (Index_Type'First) + Int (LN) + Int (RN) - 1; + N : constant Int'Base := Int (LN) + Int (RN); + Last_As_Int : Int'Base; begin - if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + if Int (No_Index) > Int'Last - N then + raise Constraint_Error with "new length is out of range"; + end if; + + Last_As_Int := Int (No_Index) + N; + + if Last_As_Int > Int (Index_Type'Last) then + raise Constraint_Error with "new length is out of range"; end if; declare @@ -209,12 +216,17 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - Last_As_Int : constant Int'Base := - Int (Index_Type'First) + Int (LN); + Last_As_Int : Int'Base; begin - if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + if Int (Index_Type'First) > Int'Last - Int (LN) then + raise Constraint_Error with "new length is out of range"; + end if; + + Last_As_Int := Int (Index_Type'First) + Int (LN); + + if Last_As_Int > Int (Index_Type'Last) then + raise Constraint_Error with "new length is out of range"; end if; declare @@ -285,12 +297,17 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - Last_As_Int : constant Int'Base := - Int (Index_Type'First) + Int (RN); + Last_As_Int : Int'Base; begin - if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + if Int (Index_Type'First) > Int'Last - Int (RN) then + raise Constraint_Error with "new length is out of range"; + end if; + + Last_As_Int := Int (Index_Type'First) + Int (RN); + + if Last_As_Int > Int (Index_Type'Last) then + raise Constraint_Error with "new length is out of range"; end if; declare @@ -339,7 +356,7 @@ package body Ada.Containers.Indefinite_Vectors is function "&" (Left, Right : Element_Type) return Vector is begin if Index_Type'First >= Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with "new length is out of range"; end if; declare @@ -348,6 +365,7 @@ package body Ada.Containers.Indefinite_Vectors is subtype ET is Elements_Type (Index_Type'First .. Last); Elements : Elements_Access := new ET; + begin begin Elements (Elements'First) := new Element_Type'(Left); @@ -445,7 +463,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with "vector is already at its maximum length"; end if; Insert @@ -465,7 +483,7 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with "vector is already at its maximum length"; end if; Insert @@ -495,7 +513,8 @@ package body Ada.Containers.Indefinite_Vectors is procedure Clear (Container : in out Vector) is begin if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; while Container.Last >= Index_Type'First loop @@ -532,12 +551,12 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Index < Index_Type'First then - raise Constraint_Error; + raise Constraint_Error with "Index is out of range (too small)"; end if; if Index > Container.Last then if Index > Container.Last + 1 then - raise Constraint_Error; + raise Constraint_Error with "Index is out of range (too large)"; end if; return; @@ -548,14 +567,14 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; declare Index_As_Int : constant Int := Int (Index); Old_Last_As_Int : constant Int := Int (Container.Last); - -- TODO: somewhat vestigial...fix ??? Count1 : constant Int'Base := Int (Count); Count2 : constant Int'Base := Old_Last_As_Int - Index_As_Int + 1; N : constant Int'Base := Int'Min (Count1, Count2); @@ -609,13 +628,15 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Position.Container = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; - if Position.Container /= Container'Unchecked_Access - or else Position.Index > Container.Last - then - raise Program_Error; + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error with "Position cursor denotes wrong container"; + end if; + + if Position.Index > Container.Last then + raise Program_Error with "Position index is out of range"; end if; Delete (Container, Position.Index, Count); @@ -662,7 +683,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; declare @@ -693,7 +715,7 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Index > Container.Last then - raise Constraint_Error; + raise Constraint_Error with "Index is out of range"; end if; declare @@ -701,7 +723,7 @@ package body Ada.Containers.Indefinite_Vectors is begin if EA = null then - raise Constraint_Error; + raise Constraint_Error with "element is empty"; end if; return EA.all; @@ -711,7 +733,7 @@ package body Ada.Containers.Indefinite_Vectors is function Element (Position : Cursor) return Element_Type is begin if Position.Container = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; return Element (Position.Container.all, Position.Index); @@ -723,7 +745,7 @@ package body Ada.Containers.Indefinite_Vectors is procedure Finalize (Container : in out Vector) is begin - Clear (Container); + Clear (Container); -- Checks busy-bit declare X : Elements_Access := Container.Elements; @@ -743,11 +765,14 @@ package body Ada.Containers.Indefinite_Vectors is Position : Cursor := No_Element) return Cursor is begin - if Position.Container /= null - and then (Position.Container /= Container'Unchecked_Access - or else Position.Index > Container.Last) - then - raise Program_Error; + if Position.Container /= null then + if Position.Container /= Container'Unrestricted_Access then + raise Program_Error with "Position cursor denotes wrong container"; + end if; + + if Position.Index > Container.Last then + raise Program_Error with "Position index is out of range"; + end if; end if; for J in Position.Index .. Container.Last loop @@ -888,7 +913,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Source.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; Target.Set_Length (Length (Target) + Length (Source)); @@ -963,7 +989,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Lock > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with cursors (vector is locked)"; end if; Sort (Container.Elements (Index_Type'First .. Container.Last)); @@ -996,20 +1023,25 @@ package body Ada.Containers.Indefinite_Vectors is is N : constant Int := Int (Count); + First : constant Int := Int (Index_Type'First); New_Last_As_Int : Int'Base; New_Last : Index_Type; + New_Length : UInt; + Max_Length : constant UInt := UInt (Count_Type'Last); Dst : Elements_Access; begin if Before < Index_Type'First then - raise Constraint_Error; + raise Constraint_Error with + "Before index is out of range (too small)"; end if; if Before > Container.Last and then Before > Container.Last + 1 then - raise Constraint_Error; + raise Constraint_Error with + "Before index is out of range (too large)"; end if; if Count = 0 then @@ -1020,17 +1052,28 @@ package body Ada.Containers.Indefinite_Vectors is Old_Last_As_Int : constant Int := Int (Container.Last); begin + if Old_Last_As_Int > Int'Last - N then -- see a-convec.adb ??? + raise Constraint_Error with "new length is out of range"; + end if; + New_Last_As_Int := Old_Last_As_Int + N; - if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + if New_Last_As_Int > Int (Index_Type'Last) then + raise Constraint_Error with "new length is out of range"; + end if; + + New_Length := UInt (New_Last_As_Int - First + 1); + + if New_Length > Max_Length then + raise Constraint_Error with "new length is out of range"; end if; New_Last := Index_Type (New_Last_As_Int); end; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; if Container.Elements = null then @@ -1050,6 +1093,7 @@ package body Ada.Containers.Indefinite_Vectors is if New_Last <= Container.Elements'Last then declare E : Elements_Type renames Container.Elements.all; + begin if Before <= Container.Last then declare @@ -1058,16 +1102,18 @@ package body Ada.Containers.Indefinite_Vectors is Index : constant Index_Type := Index_Type (Index_As_Int); - J : Index_Type'Base := Before; + J : Index_Type'Base; begin E (Index .. New_Last) := E (Before .. Container.Last); Container.Last := New_Last; + J := Before; while J < Index loop E (J) := new Element_Type'(New_Item); J := J + 1; end loop; + exception when others => E (J .. Index - 1) := (others => null); @@ -1086,35 +1132,40 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - First : constant Int := Int (Index_Type'First); - New_Size : constant Int'Base := New_Last_As_Int - First + 1; - Size : Int'Base := Int'Max (1, Container.Elements'Length); + C, CC : UInt; begin - while Size < New_Size loop - if Size > Int'Last / 2 then - Size := Int'Last; + C := UInt'Max (1, Container.Elements'Length); + while C < New_Length loop + if C > UInt'Last / 2 then + C := UInt'Last; exit; end if; - Size := 2 * Size; + C := 2 * C; end loop; - -- 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. + if C > Max_Length then + C := Max_Length; + end if; - declare - Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1; - begin - if Size > Max_Size then - Size := Max_Size; - end if; - end; + if Index_Type'First <= 0 + and then Index_Type'Last >= 0 + then + CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1; + + else + CC := UInt (Int (Index_Type'Last) - First + 1); + end if; + + if C > CC then + C := CC; + end if; declare - Dst_Last : constant Index_Type := Index_Type (First + Size - 1); + Dst_Last : constant Index_Type := + Index_Type (First + UInt'Pos (C) - Int'(1)); + begin Dst := new Elements_Type (Index_Type'First .. Dst_Last); end; @@ -1172,13 +1223,15 @@ package body Ada.Containers.Indefinite_Vectors is begin if Before < Index_Type'First then - raise Constraint_Error; + raise Constraint_Error with + "Before index is out of range (too small)"; end if; if Before > Container.Last and then Before > Container.Last + 1 then - raise Constraint_Error; + raise Constraint_Error with + "Before index is out of range (too large)"; end if; if N = 0 then @@ -1268,7 +1321,7 @@ package body Ada.Containers.Indefinite_Vectors is if Before.Container /= null and then Before.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with "Before cursor denotes wrong container"; end if; if Is_Empty (New_Item) then @@ -1279,7 +1332,8 @@ package body Ada.Containers.Indefinite_Vectors is or else Before.Index > Container.Last then if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with + "vector is already at its maximum length"; end if; Index := Container.Last + 1; @@ -1303,7 +1357,7 @@ package body Ada.Containers.Indefinite_Vectors is if Before.Container /= null and then Before.Container /= Vector_Access'(Container'Unchecked_Access) then - raise Program_Error; + raise Program_Error with "Before cursor denotes wrong container"; end if; if Is_Empty (New_Item) then @@ -1322,7 +1376,8 @@ package body Ada.Containers.Indefinite_Vectors is or else Before.Index > Container.Last then if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with + "vector is already at its maximum length"; end if; Index := Container.Last + 1; @@ -1346,9 +1401,9 @@ package body Ada.Containers.Indefinite_Vectors is begin if Before.Container /= null - and then Before.Container /= Vector_Access'(Container'Unchecked_Access) + and then Before.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with "Before cursor denotes wrong container"; end if; if Count = 0 then @@ -1359,7 +1414,8 @@ package body Ada.Containers.Indefinite_Vectors is or else Before.Index > Container.Last then if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with + "vector is already at its maximum length"; end if; Index := Container.Last + 1; @@ -1382,9 +1438,9 @@ package body Ada.Containers.Indefinite_Vectors is begin if Before.Container /= null - and then Before.Container /= Vector_Access'(Container'Unchecked_Access) + and then Before.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with "Before cursor denotes wrong container"; end if; if Count = 0 then @@ -1403,7 +1459,8 @@ package body Ada.Containers.Indefinite_Vectors is or else Before.Index > Container.Last then if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with + "vector is already at its maximum length"; end if; Index := Container.Last + 1; @@ -1428,20 +1485,25 @@ package body Ada.Containers.Indefinite_Vectors is is N : constant Int := Int (Count); + First : constant Int := Int (Index_Type'First); New_Last_As_Int : Int'Base; New_Last : Index_Type; + New_Length : UInt; + Max_Length : constant UInt := UInt (Count_Type'Last); Dst : Elements_Access; begin if Before < Index_Type'First then - raise Constraint_Error; + raise Constraint_Error with + "Before index is out of range (too small)"; end if; if Before > Container.Last and then Before > Container.Last + 1 then - raise Constraint_Error; + raise Constraint_Error with + "Before index is out of range (too large)"; end if; if Count = 0 then @@ -1452,17 +1514,28 @@ package body Ada.Containers.Indefinite_Vectors is Old_Last_As_Int : constant Int := Int (Container.Last); begin + if Old_Last_As_Int > Int'Last - N then -- see a-convec.adb ??? + raise Constraint_Error with "new length is out of range"; + end if; + New_Last_As_Int := Old_Last_As_Int + N; - if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + if New_Last_As_Int > Int (Index_Type'Last) then + raise Constraint_Error with "new length is out of range"; + end if; + + New_Length := UInt (New_Last_As_Int - First + 1); + + if New_Length > Max_Length then + raise Constraint_Error with "new length is out of range"; end if; New_Last := Index_Type (New_Last_As_Int); end; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; if Container.Elements = null then @@ -1497,35 +1570,40 @@ package body Ada.Containers.Indefinite_Vectors is end if; declare - First : constant Int := Int (Index_Type'First); - New_Size : constant Int'Base := New_Last_As_Int - First + 1; - Size : Int'Base := Int'Max (1, Container.Elements'Length); + C, CC : UInt; begin - while Size < New_Size loop - if Size > Int'Last / 2 then - Size := Int'Last; + C := UInt'Max (1, Container.Elements'Length); + while C < New_Length loop + if C > UInt'Last / 2 then + C := UInt'Last; exit; end if; - Size := 2 * Size; + C := 2 * C; end loop; - -- 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. + if C > Max_Length then + C := Max_Length; + end if; - declare - Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1; - begin - if Size > Max_Size then - Size := Max_Size; - end if; - end; + if Index_Type'First <= 0 + and then Index_Type'Last >= 0 + then + CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1; + + else + CC := UInt (Int (Index_Type'Last) - First + 1); + end if; + + if C > CC then + C := CC; + end if; declare - Dst_Last : constant Index_Type := Index_Type (First + Size - 1); + Dst_Last : constant Index_Type := + Index_Type (First + UInt'Pos (C) - 1); + begin Dst := new Elements_Type (Index_Type'First .. Dst_Last); end; @@ -1570,9 +1648,9 @@ package body Ada.Containers.Indefinite_Vectors is begin if Before.Container /= null - and then Before.Container /= Vector_Access'(Container'Unchecked_Access) + and then Before.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with "Before cursor denotes wrong container"; end if; if Count = 0 then @@ -1591,7 +1669,8 @@ package body Ada.Containers.Indefinite_Vectors is or else Before.Index > Container.Last then if Container.Last = Index_Type'Last then - raise Constraint_Error; + raise Constraint_Error with + "vector is already at its maximum length"; end if; Index := Container.Last + 1; @@ -1682,10 +1761,6 @@ package body Ada.Containers.Indefinite_Vectors is 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; @@ -1703,10 +1778,11 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Source.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (Source is busy)"; end if; - Clear (Target); + Clear (Target); -- Checks busy-bit declare Target_Elements : constant Elements_Access := Target.Elements; @@ -1819,11 +1895,11 @@ package body Ada.Containers.Indefinite_Vectors is begin if Index > Container.Last then - raise Constraint_Error; + raise Constraint_Error with "Index is out of range"; end if; if V.Elements (Index) = null then - raise Constraint_Error; + raise Constraint_Error with "element is null"; end if; B := B + 1; @@ -1848,7 +1924,7 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Position.Container = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; Query_Element (Position.Container.all, Position.Index, Process); @@ -1859,7 +1935,7 @@ package body Ada.Containers.Indefinite_Vectors is ---------- procedure Read - (Stream : access Root_Stream_Type'Class; + (Stream : not null access Root_Stream_Type'Class; Container : out Vector) is Length : Count_Type'Base; @@ -1891,11 +1967,11 @@ package body Ada.Containers.Indefinite_Vectors is end Read; procedure Read - (Stream : access Root_Stream_Type'Class; + (Stream : not null access Root_Stream_Type'Class; Position : out Cursor) is begin - raise Program_Error; + raise Program_Error with "attempt to stream vector cursor"; end Read; --------------------- @@ -1909,11 +1985,12 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Index > Container.Last then - raise Constraint_Error; + raise Constraint_Error with "Index is out of range"; end if; if Container.Lock > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with cursors (vector is locked)"; end if; declare @@ -1931,11 +2008,11 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Position.Container = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; if Position.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with "Position cursor denotes wrong container"; end if; Replace_Element (Container, Position.Index, New_Item); @@ -1963,7 +2040,8 @@ package body Ada.Containers.Indefinite_Vectors is elsif N < Container.Elements'Length then if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; declare @@ -1994,7 +2072,7 @@ package body Ada.Containers.Indefinite_Vectors is begin if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + raise Constraint_Error with "new length is out of range"; end if; declare @@ -2014,7 +2092,8 @@ package body Ada.Containers.Indefinite_Vectors is if Capacity <= N then if N < Container.Elements'Length then if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; declare @@ -2043,7 +2122,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; declare @@ -2052,7 +2132,7 @@ package body Ada.Containers.Indefinite_Vectors is begin if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + raise Constraint_Error with "new length is out of range"; end if; declare @@ -2093,15 +2173,18 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Lock > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with cursors (vector is locked)"; end if; declare - I : Index_Type := Index_Type'First; - J : Index_Type := Container.Last; + I : Index_Type; + J : Index_Type; E : Elements_Type renames Container.Elements.all; begin + I := Index_Type'First; + J := Container.Last; while I < J loop declare EI : constant Element_Access := E (I); @@ -2132,7 +2215,7 @@ package body Ada.Containers.Indefinite_Vectors is if Position.Container /= null and then Position.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with "Position cursor denotes wrong container"; end if; if Position.Container = null @@ -2226,7 +2309,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (vector is busy)"; end if; if Length < N then @@ -2267,10 +2351,12 @@ package body Ada.Containers.Indefinite_Vectors is I, J : Index_Type) is begin - if I > Container.Last - or else J > Container.Last - then - raise Constraint_Error; + if I > Container.Last then + raise Constraint_Error with "I index is out of range"; + end if; + + if J > Container.Last then + raise Constraint_Error with "J index is out of range"; end if; if I = J then @@ -2278,7 +2364,8 @@ package body Ada.Containers.Indefinite_Vectors is end if; if Container.Lock > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with cursors (vector is locked)"; end if; declare @@ -2298,16 +2385,20 @@ package body Ada.Containers.Indefinite_Vectors is I, J : Cursor) is begin - if I.Container = null - or else J.Container = null - then - raise Constraint_Error; + if I.Container = null then + raise Constraint_Error with "I cursor has no element"; end if; - if I.Container /= Container'Unrestricted_Access - or else J.Container /= Container'Unrestricted_Access - then - raise Program_Error; + if J.Container = null then + raise Constraint_Error with "J cursor has no element"; + end if; + + if I.Container /= Container'Unrestricted_Access then + raise Program_Error with "I cursor denotes wrong container"; + end if; + + if J.Container /= Container'Unrestricted_Access then + raise Program_Error with "J cursor denotes wrong container"; end if; Swap (Container, I.Index, J.Index); @@ -2364,7 +2455,7 @@ package body Ada.Containers.Indefinite_Vectors is begin if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + raise Constraint_Error with "Length is out of range"; end if; Last := Index_Type (Last_As_Int); @@ -2391,7 +2482,7 @@ package body Ada.Containers.Indefinite_Vectors is begin if Last_As_Int > Index_Type'Pos (Index_Type'Last) then - raise Constraint_Error; + raise Constraint_Error with "Length is out of range"; end if; Last := Index_Type (Last_As_Int); @@ -2433,11 +2524,11 @@ package body Ada.Containers.Indefinite_Vectors is begin if Index > Container.Last then - raise Constraint_Error; + raise Constraint_Error with "Index is out of range"; end if; if Container.Elements (Index) = null then - raise Constraint_Error; + raise Constraint_Error with "element is null"; end if; B := B + 1; @@ -2463,11 +2554,11 @@ package body Ada.Containers.Indefinite_Vectors is is begin if Position.Container = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; if Position.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with "Position cursor denotes wrong container"; end if; Update_Element (Container, Position.Index, Process); @@ -2478,7 +2569,7 @@ package body Ada.Containers.Indefinite_Vectors is ----------- procedure Write - (Stream : access Root_Stream_Type'Class; + (Stream : not null access Root_Stream_Type'Class; Container : Vector) is N : constant Count_Type := Length (Container); @@ -2499,7 +2590,7 @@ package body Ada.Containers.Indefinite_Vectors is -- There's another way to do this. Instead a separate -- Boolean for each element, you could write a Boolean -- followed by a count of how many nulls or non-nulls - -- follow in the array. + -- follow in the array. ??? if E (Indx) = null then Boolean'Write (Stream, False); @@ -2512,11 +2603,11 @@ package body Ada.Containers.Indefinite_Vectors is end Write; procedure Write - (Stream : access Root_Stream_Type'Class; + (Stream : not null access Root_Stream_Type'Class; Position : Cursor) is begin - raise Program_Error; + raise Program_Error with "attempt to stream vector cursor"; end Write; end Ada.Containers.Indefinite_Vectors; |