Skip to content

R
riscv-gcc-1
Commit 7cdc672b by Matthew Heaney Committed by Arnaud Charlet
Options

a-convec.adb (Merge): Added assertions to check whether vector params are sorted. 

2005-12-05  Matthew Heaney  <heaney@adacore.com>

	* a-convec.adb (Merge): Added assertions to check whether vector params
	are sorted.

	* a-coinve.adb (Merge): Added assertions to check whether vector params
	are sorted.

	* a-cohama.ads (Cursor'Write): raises Program_Error per latest AI-302
	draft.
	(Cursor'Read): raises PE

	* a-cohama.adb (Insert.New_Node): Uses box-style syntax to init elem
	to its default value.

	* a-cihama.adb: Manually check whether cursor's key and elem are
	non-null

	* a-cidlli.ads, a-cidlli.adb (Splice): Changed param name and param mode
	(Merge): Assert that target and source lists are in order
	(Swap): Declare non-const temporaries, to pass to Splice

	* a-cdlili.ads: (Splice): Changed param name and param mode

	* a-cdlili.adb: (Splice): Changed param name and param mode
	(Merge): Assert that target and source lists are in order
	(Swap): Declare non-const temporaries, to pass to Splice

	* a-ciorma.ads, a-coorma.ads: (Read): declare Stream param as not null
	(Write): declare Stream param as not null

	* a-ciorma.adb, a-coorma.adb: All explicit raise statements now include
	an exception message.

From-SVN: r108287
parent 9582a3cd
Showing with 351 additions and 233 deletions
gcc/ada/a-cdlili.adb
...@@ -466,11 +466,19 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -466,11 +466,19 @@ package body Ada.Containers.Doubly_Linked_Lists is
end if; end if;
while RI.Node /= null loop while RI.Node /= null loop
pragma Assert (RI.Node.Next = null
or else not (RI.Node.Next.Element <
RI.Node.Element));
if LI.Node = null then if LI.Node = null then
Splice (Target, No_Element, Source); Splice (Target, No_Element, Source);
return; return;
end if; end if;
pragma Assert (LI.Node.Next = null
or else not (LI.Node.Next.Element <
LI.Node.Element));
if RI.Node.Element < LI.Node.Element then if RI.Node.Element < LI.Node.Element then
declare declare
RJ : Cursor := RI; RJ : Cursor := RI;
...@@ -1289,13 +1297,13 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1289,13 +1297,13 @@ package body Ada.Containers.Doubly_Linked_Lists is
end Splice; end Splice;
procedure Splice procedure Splice
(Target : in out List; (Container : in out List;
Before : Cursor; Before : Cursor;
Position : Cursor) Position : in out Cursor)
is is
begin begin
if Before.Container /= null then if Before.Container /= null then
if Before.Container /= Target'Unchecked_Access then if Before.Container /= Container'Unchecked_Access then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -1306,7 +1314,7 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1306,7 +1314,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Container /= Target'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -1318,59 +1326,59 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1318,59 +1326,59 @@ package body Ada.Containers.Doubly_Linked_Lists is
return; return;
end if; end if;
pragma Assert (Target.Length >= 2); pragma Assert (Container.Length >= 2);
if Target.Busy > 0 then if Container.Busy > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
if Before.Node = null then if Before.Node = null then
pragma Assert (Position.Node /= Target.Last); pragma Assert (Position.Node /= Container.Last);
if Position.Node = Target.First then if Position.Node = Container.First then
Target.First := Position.Node.Next; Container.First := Position.Node.Next;
Target.First.Prev := null; Container.First.Prev := null;
else else
Position.Node.Prev.Next := Position.Node.Next; Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev; Position.Node.Next.Prev := Position.Node.Prev;
end if; end if;
Target.Last.Next := Position.Node; Container.Last.Next := Position.Node;
Position.Node.Prev := Target.Last; Position.Node.Prev := Container.Last;
Target.Last := Position.Node; Container.Last := Position.Node;
Target.Last.Next := null; Container.Last.Next := null;
return; return;
end if; end if;
if Before.Node = Target.First then if Before.Node = Container.First then
pragma Assert (Position.Node /= Target.First); pragma Assert (Position.Node /= Container.First);
if Position.Node = Target.Last then if Position.Node = Container.Last then
Target.Last := Position.Node.Prev; Container.Last := Position.Node.Prev;
Target.Last.Next := null; Container.Last.Next := null;
else else
Position.Node.Prev.Next := Position.Node.Next; Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev; Position.Node.Next.Prev := Position.Node.Prev;
end if; end if;
Target.First.Prev := Position.Node; Container.First.Prev := Position.Node;
Position.Node.Next := Target.First; Position.Node.Next := Container.First;
Target.First := Position.Node; Container.First := Position.Node;
Target.First.Prev := null; Container.First.Prev := null;
return; return;
end if; end if;
if Position.Node = Target.First then if Position.Node = Container.First then
Target.First := Position.Node.Next; Container.First := Position.Node.Next;
Target.First.Prev := null; Container.First.Prev := null;
elsif Position.Node = Target.Last then elsif Position.Node = Container.Last then
Target.Last := Position.Node.Prev; Container.Last := Position.Node.Prev;
Target.Last.Next := null; Container.Last.Next := null;
else else
Position.Node.Prev.Next := Position.Node.Next; Position.Node.Prev.Next := Position.Node.Next;
...@@ -1383,8 +1391,8 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1383,8 +1391,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
Before.Node.Prev := Position.Node; Before.Node.Prev := Position.Node;
Position.Node.Next := Before.Node; Position.Node.Next := Before.Node;
pragma Assert (Target.First.Prev = null); pragma Assert (Container.First.Prev = null);
pragma Assert (Target.Last.Next = null); pragma Assert (Container.Last.Next = null);
end Splice; end Splice;
procedure Splice procedure Splice
...@@ -1570,24 +1578,26 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -1570,24 +1578,26 @@ package body Ada.Containers.Doubly_Linked_Lists is
declare declare
I_Next : constant Cursor := Next (I); I_Next : constant Cursor := Next (I);
J_Copy : Cursor := J;
begin begin
if I_Next = J then if I_Next = J then
Splice (Container, Before => I, Position => J); Splice (Container, Before => I, Position => J_Copy);
else else
declare declare
J_Next : constant Cursor := Next (J); J_Next : constant Cursor := Next (J);
I_Copy : Cursor := I;
begin begin
if J_Next = I then if J_Next = I then
Splice (Container, Before => J, Position => I); Splice (Container, Before => J, Position => I_Copy);
else else
pragma Assert (Container.Length >= 3); pragma Assert (Container.Length >= 3);
Splice (Container, Before => I_Next, Position => J); Splice (Container, Before => I_Next, Position => J_Copy);
Splice (Container, Before => J_Next, Position => I); Splice (Container, Before => J_Next, Position => I_Copy);
end if; end if;
end; end;
end if; end if;
......
gcc/ada/a-cdlili.ads
...@@ -145,9 +145,9 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -145,9 +145,9 @@ package Ada.Containers.Doubly_Linked_Lists is
Position : in out Cursor); Position : in out Cursor);
procedure Splice procedure Splice
(Target : in out List; (Container : in out List;
Before : Cursor; Before : Cursor;
Position : Cursor); Position : in out Cursor);
function First (Container : List) return Cursor; function First (Container : List) return Cursor;
......
gcc/ada/a-cidlli.adb
...@@ -514,11 +514,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -514,11 +514,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
LI := First (Target); LI := First (Target);
RI := First (Source); RI := First (Source);
while RI.Node /= null loop while RI.Node /= null loop
pragma Assert (RI.Node.Next = null
or else not (RI.Node.Next.Element.all <
RI.Node.Element.all));
if LI.Node = null then if LI.Node = null then
Splice (Target, No_Element, Source); Splice (Target, No_Element, Source);
return; return;
end if; end if;
pragma Assert (LI.Node.Next = null
or else not (LI.Node.Next.Element.all <
LI.Node.Element.all));
if RI.Node.Element.all < LI.Node.Element.all then if RI.Node.Element.all < LI.Node.Element.all then
declare declare
RJ : Cursor := RI; RJ : Cursor := RI;
...@@ -1333,13 +1341,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -1333,13 +1341,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
end Splice; end Splice;
procedure Splice procedure Splice
(Target : in out List; (Container : in out List;
Before : Cursor; Before : Cursor;
Position : Cursor) Position : in out Cursor)
is is
begin begin
if Before.Container /= null then if Before.Container /= null then
if Before.Container /= Target'Unchecked_Access then if Before.Container /= Container'Unchecked_Access then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -1360,7 +1368,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -1360,7 +1368,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
raise Program_Error; raise Program_Error;
end if; end if;
if Position.Container /= Target'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -1372,59 +1380,59 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -1372,59 +1380,59 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
return; return;
end if; end if;
pragma Assert (Target.Length >= 2); pragma Assert (Container.Length >= 2);
if Target.Busy > 0 then if Container.Busy > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
if Before.Node = null then if Before.Node = null then
pragma Assert (Position.Node /= Target.Last); pragma Assert (Position.Node /= Container.Last);
if Position.Node = Target.First then if Position.Node = Container.First then
Target.First := Position.Node.Next; Container.First := Position.Node.Next;
Target.First.Prev := null; Container.First.Prev := null;
else else
Position.Node.Prev.Next := Position.Node.Next; Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev; Position.Node.Next.Prev := Position.Node.Prev;
end if; end if;
Target.Last.Next := Position.Node; Container.Last.Next := Position.Node;
Position.Node.Prev := Target.Last; Position.Node.Prev := Container.Last;
Target.Last := Position.Node; Container.Last := Position.Node;
Target.Last.Next := null; Container.Last.Next := null;
return; return;
end if; end if;
if Before.Node = Target.First then if Before.Node = Container.First then
pragma Assert (Position.Node /= Target.First); pragma Assert (Position.Node /= Container.First);
if Position.Node = Target.Last then if Position.Node = Container.Last then
Target.Last := Position.Node.Prev; Container.Last := Position.Node.Prev;
Target.Last.Next := null; Container.Last.Next := null;
else else
Position.Node.Prev.Next := Position.Node.Next; Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev; Position.Node.Next.Prev := Position.Node.Prev;
end if; end if;
Target.First.Prev := Position.Node; Container.First.Prev := Position.Node;
Position.Node.Next := Target.First; Position.Node.Next := Container.First;
Target.First := Position.Node; Container.First := Position.Node;
Target.First.Prev := null; Container.First.Prev := null;
return; return;
end if; end if;
if Position.Node = Target.First then if Position.Node = Container.First then
Target.First := Position.Node.Next; Container.First := Position.Node.Next;
Target.First.Prev := null; Container.First.Prev := null;
elsif Position.Node = Target.Last then elsif Position.Node = Container.Last then
Target.Last := Position.Node.Prev; Container.Last := Position.Node.Prev;
Target.Last.Next := null; Container.Last.Next := null;
else else
Position.Node.Prev.Next := Position.Node.Next; Position.Node.Prev.Next := Position.Node.Next;
...@@ -1437,8 +1445,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -1437,8 +1445,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
Before.Node.Prev := Position.Node; Before.Node.Prev := Position.Node;
Position.Node.Next := Before.Node; Position.Node.Next := Before.Node;
pragma Assert (Target.First.Prev = null); pragma Assert (Container.First.Prev = null);
pragma Assert (Target.Last.Next = null); pragma Assert (Container.Last.Next = null);
end Splice; end Splice;
procedure Splice procedure Splice
...@@ -1631,23 +1639,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -1631,23 +1639,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
declare declare
I_Next : constant Cursor := Next (I); I_Next : constant Cursor := Next (I);
J_Copy : Cursor := J;
begin begin
if I_Next = J then if I_Next = J then
Splice (Container, Before => I, Position => J); Splice (Container, Before => I, Position => J_Copy);
else else
declare declare
J_Next : constant Cursor := Next (J); J_Next : constant Cursor := Next (J);
I_Copy : Cursor := I;
begin begin
if J_Next = I then if J_Next = I then
Splice (Container, Before => J, Position => I); Splice (Container, Before => J, Position => I_Copy);
else else
pragma Assert (Container.Length >= 3); pragma Assert (Container.Length >= 3);
Splice (Container, Before => I_Next, Position => J); Splice (Container, Before => I_Next, Position => J_Copy);
Splice (Container, Before => J_Next, Position => I); Splice (Container, Before => J_Next, Position => I_Copy);
end if; end if;
end; end;
end if; end if;
......
gcc/ada/a-cidlli.ads
...@@ -136,9 +136,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -136,9 +136,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Position : in out Cursor); Position : in out Cursor);
procedure Splice procedure Splice
(Target : in out List; (Container : in out List;
Before : Cursor; Before : Cursor;
Position : Cursor); Position : in out Cursor);
function First (Container : List) return Cursor; function First (Container : List) return Cursor;
......
gcc/ada/a-cihama.adb
...@@ -237,6 +237,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -237,6 +237,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Node.Element = null then
raise Program_Error;
end if;
return Position.Node.Element.all; return Position.Node.Element.all;
end Element; end Element;
...@@ -267,6 +271,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -267,6 +271,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Left.Node.Key = null
or else Right.Node.Key = null
then
raise Program_Error;
end if;
return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all); return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all);
end Equivalent_Keys; end Equivalent_Keys;
...@@ -281,6 +291,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -281,6 +291,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Left.Node.Key = null then
raise Program_Error;
end if;
return Equivalent_Keys (Left.Node.Key.all, Right); return Equivalent_Keys (Left.Node.Key.all, Right);
end Equivalent_Keys; end Equivalent_Keys;
...@@ -295,6 +309,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -295,6 +309,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Right.Node.Key = null then
raise Program_Error;
end if;
return Equivalent_Keys (Left, Right.Node.Key.all); return Equivalent_Keys (Left, Right.Node.Key.all);
end Equivalent_Keys; end Equivalent_Keys;
...@@ -595,6 +613,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -595,6 +613,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Node.Key = null then
raise Program_Error;
end if;
return Position.Node.Key.all; return Position.Node.Key.all;
end Key; end Key;
...@@ -641,6 +663,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -641,6 +663,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
return No_Element; return No_Element;
end if; end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
end if;
declare declare
HT : Hash_Table_Type renames Position.Container.HT; HT : Hash_Table_Type renames Position.Container.HT;
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node); Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
...@@ -670,6 +698,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -670,6 +698,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
end if;
declare declare
M : Map renames Position.Container.all; M : Map renames Position.Container.all;
HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
...@@ -807,6 +841,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -807,6 +841,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -862,6 +902,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -862,6 +902,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error;
end if; end if;
......
gcc/ada/a-ciorma.adb
...@@ -135,23 +135,27 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -135,23 +135,27 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function "<" (Left, Right : Cursor) return Boolean is function "<" (Left, Right : Cursor) return Boolean is
begin begin
if Left.Node = null if Left.Node = null then
or else Right.Node = null raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
then
raise Constraint_Error;
end if; end if;
if Left.Node.Key = null if Right.Node = null then
or else Right.Node.Key = null raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
then end if;
raise Program_Error;
if Left.Node.Key = null then
raise Program_Error with "Left cursor in ""<"" is bad";
end if;
if Right.Node.Key = null then
raise Program_Error with "Right cursor in ""<"" is bad";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in ""<"""); "Left cursor in ""<"" is bad");
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in ""<"""); "Right cursor in ""<"" is bad");
return Left.Node.Key.all < Right.Node.Key.all; return Left.Node.Key.all < Right.Node.Key.all;
end "<"; end "<";
...@@ -159,15 +163,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -159,15 +163,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function "<" (Left : Cursor; Right : Key_Type) return Boolean is function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin begin
if Left.Node = null then if Left.Node = null then
raise Constraint_Error; raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
end if; end if;
if Left.Node.Key = null then if Left.Node.Key = null then
raise Program_Error; raise Program_Error with "Left cursor in ""<"" is bad";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in ""<"""); "Left cursor in ""<"" is bad");
return Left.Node.Key.all < Right; return Left.Node.Key.all < Right;
end "<"; end "<";
...@@ -175,15 +179,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -175,15 +179,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function "<" (Left : Key_Type; Right : Cursor) return Boolean is function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin begin
if Right.Node = null then if Right.Node = null then
raise Constraint_Error; raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if; end if;
if Right.Node.Key = null then if Right.Node.Key = null then
raise Program_Error; raise Program_Error with "Right cursor in ""<"" is bad";
end if; end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in ""<"""); "Right cursor in ""<"" is bad");
return Left < Right.Node.Key.all; return Left < Right.Node.Key.all;
end "<"; end "<";
...@@ -203,23 +207,27 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -203,23 +207,27 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left, Right : Cursor) return Boolean is function ">" (Left, Right : Cursor) return Boolean is
begin begin
if Left.Node = null if Left.Node = null then
or else Right.Node = null raise Constraint_Error with "Left cursor of "">"" equals No_Element";
then
raise Constraint_Error;
end if; end if;
if Left.Node.Key = null if Right.Node = null then
or else Right.Node.Key = null raise Constraint_Error with "Right cursor of "">"" equals No_Element";
then end if;
raise Program_Error;
if Left.Node.Key = null then
raise Program_Error with "Left cursor in ""<"" is bad";
end if;
if Right.Node.Key = null then
raise Program_Error with "Right cursor in ""<"" is bad";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in "">"""); "Left cursor in "">"" is bad");
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in "">"""); "Right cursor in "">"" is bad");
return Right.Node.Key.all < Left.Node.Key.all; return Right.Node.Key.all < Left.Node.Key.all;
end ">"; end ">";
...@@ -227,15 +235,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -227,15 +235,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left : Cursor; Right : Key_Type) return Boolean is function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin begin
if Left.Node = null then if Left.Node = null then
raise Constraint_Error; raise Constraint_Error with "Left cursor of "">"" equals No_Element";
end if; end if;
if Left.Node.Key = null then if Left.Node.Key = null then
raise Program_Error; raise Program_Error with "Left cursor in ""<"" is bad";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in "">"""); "Left cursor in "">"" is bad");
return Right < Left.Node.Key.all; return Right < Left.Node.Key.all;
end ">"; end ">";
...@@ -243,15 +251,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -243,15 +251,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean is function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin begin
if Right.Node = null then if Right.Node = null then
raise Constraint_Error; raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if; end if;
if Right.Node.Key = null then if Right.Node.Key = null then
raise Program_Error; raise Program_Error with "Right cursor in ""<"" is bad";
end if; end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in "">"""); "Right cursor in "">"" is bad");
return Right.Node.Key.all < Left; return Right.Node.Key.all < Left;
end ">"; end ">";
...@@ -346,21 +354,23 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -346,21 +354,23 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Delete equals No_Element";
end if; end if;
if Position.Node.Key = null if Position.Node.Key = null
or else Position.Node.Element = null or else Position.Node.Element = null
then then
raise Program_Error; raise Program_Error with "Position cursor of Delete is bad";
end if; end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error with
"Position cursor of Delete designates wrong map";
end if; end if;
pragma Assert (Vet (Container.Tree, Position.Node), pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Delete"); "Position cursor of Delete is bad");
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node); Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
Free (Position.Node); Free (Position.Node);
...@@ -373,7 +383,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -373,7 +383,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if X = null then if X = null then
raise Constraint_Error; raise Constraint_Error with "key not in map";
end if; end if;
Delete_Node_Sans_Free (Container.Tree, X); Delete_Node_Sans_Free (Container.Tree, X);
...@@ -415,15 +425,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -415,15 +425,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Element (Position : Cursor) return Element_Type is function Element (Position : Cursor) return Element_Type is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of function Element equals No_Element";
end if; end if;
if Position.Node.Element = null then if Position.Node.Element = null then
raise Program_Error; raise Program_Error with
"Position cursor of function Element is bad";
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element"); "Position cursor of function Element is bad");
return Position.Node.Element.all; return Position.Node.Element.all;
end Element; end Element;
...@@ -433,7 +445,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -433,7 +445,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if Node = null then if Node = null then
raise Constraint_Error; raise Constraint_Error with "key not in map";
end if; end if;
return Node.Element.all; return Node.Element.all;
...@@ -507,7 +519,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -507,7 +519,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if T.First = null then if T.First = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.First.Element.all; return T.First.Element.all;
...@@ -522,7 +534,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -522,7 +534,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if T.First = null then if T.First = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.First.Key.all; return T.First.Key.all;
...@@ -619,7 +631,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -619,7 +631,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
if not Inserted then if not Inserted then
if Container.Tree.Lock > 0 then if Container.Tree.Lock > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if; end if;
K := Position.Node.Key; K := Position.Node.Key;
...@@ -706,7 +719,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -706,7 +719,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Insert (Container, Key, New_Item, Position, Inserted); Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then if not Inserted then
raise Constraint_Error; raise Constraint_Error with "key already in map";
end if; end if;
end Insert; end Insert;
...@@ -810,15 +823,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -810,15 +823,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Key (Position : Cursor) return Key_Type is function Key (Position : Cursor) return Key_Type is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of function Key equals No_Element";
end if; end if;
if Position.Node.Key = null then if Position.Node.Key = null then
raise Program_Error; raise Program_Error with
"Position cursor of function Key is bad";
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Key"); "Position cursor of function Key is bad");
return Position.Node.Key.all; return Position.Node.Key.all;
end Key; end Key;
...@@ -847,7 +862,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -847,7 +862,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if T.Last = null then if T.Last = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.Last.Element.all; return T.Last.Element.all;
...@@ -862,7 +877,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -862,7 +877,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if T.Last = null then if T.Last = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.Last.Key.all; return T.Last.Key.all;
...@@ -912,7 +927,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -912,7 +927,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
pragma Assert (Position.Node.Key /= null); pragma Assert (Position.Node.Key /= null);
pragma Assert (Position.Node.Element /= null); pragma Assert (Position.Node.Element /= null);
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Next"); "Position cursor of Next is bad");
declare declare
Node : constant Node_Access := Node : constant Node_Access :=
...@@ -955,7 +970,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -955,7 +970,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
pragma Assert (Position.Node.Key /= null); pragma Assert (Position.Node.Key /= null);
pragma Assert (Position.Node.Element /= null); pragma Assert (Position.Node.Element /= null);
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Previous"); "Position cursor of Previous is bad");
declare declare
Node : constant Node_Access := Node : constant Node_Access :=
...@@ -986,17 +1001,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -986,17 +1001,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Query_Element equals No_Element";
end if; end if;
if Position.Node.Key = null if Position.Node.Key = null
or else Position.Node.Element = null or else Position.Node.Element = null
then then
raise Program_Error; raise Program_Error with
"Position cursor of Query_Element is bad";
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Query_Element"); "Position cursor of Query_Element is bad");
declare declare
T : Tree_Type renames Position.Container.Tree; T : Tree_Type renames Position.Container.Tree;
...@@ -1031,7 +1048,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1031,7 +1048,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
---------- ----------
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : out Map) Container : out Map)
is is
function Read_Node function Read_Node
...@@ -1066,11 +1083,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1066,11 +1083,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
end Read; end Read;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor) Item : out Cursor)
is is
begin begin
raise Program_Error; raise Program_Error with "attempt to stream map cursor";
end Read; end Read;
------------- -------------
...@@ -1090,11 +1107,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1090,11 +1107,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
if Node = null then if Node = null then
raise Constraint_Error; raise Constraint_Error with "key not in map";
end if; end if;
if Container.Tree.Lock > 0 then if Container.Tree.Lock > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if; end if;
K := Node.Key; K := Node.Key;
...@@ -1125,25 +1143,29 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1125,25 +1143,29 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
end if; end if;
if Position.Node.Key = null if Position.Node.Key = null
or else Position.Node.Element = null or else Position.Node.Element = null
then then
raise Program_Error; raise Program_Error with
"Position cursor of Replace_Element is bad";
end if; end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error with
"Position cursor of Replace_Element designates wrong map";
end if; end if;
if Container.Tree.Lock > 0 then if Container.Tree.Lock > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if; end if;
pragma Assert (Vet (Container.Tree, Position.Node), pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Replace_Element"); "Position cursor of Replace_Element is bad");
declare declare
X : Element_Access := Position.Node.Element; X : Element_Access := Position.Node.Element;
...@@ -1252,21 +1274,24 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1252,21 +1274,24 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Update_Element equals No_Element";
end if; end if;
if Position.Node.Key = null if Position.Node.Key = null
or else Position.Node.Element = null or else Position.Node.Element = null
then then
raise Program_Error; raise Program_Error with
"Position cursor of Update_Element is bad";
end if; end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error with
"Position cursor of Update_Element designates wrong map";
end if; end if;
pragma Assert (Vet (Container.Tree, Position.Node), pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Update_Element"); "Position cursor of Update_Element is bad");
declare declare
T : Tree_Type renames Position.Container.Tree; T : Tree_Type renames Position.Container.Tree;
...@@ -1301,7 +1326,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1301,7 +1326,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
----------- -----------
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : Map) Container : Map)
is is
procedure Write_Node procedure Write_Node
...@@ -1332,11 +1357,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1332,11 +1357,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
end Write; end Write;
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : Cursor) Item : Cursor)
is is
begin begin
raise Program_Error; raise Program_Error with "attempt to stream map cursor";
end Write; end Write;
end Ada.Containers.Indefinite_Ordered_Maps; end Ada.Containers.Indefinite_Ordered_Maps;
gcc/ada/a-ciorma.ads
...@@ -215,13 +215,13 @@ private ...@@ -215,13 +215,13 @@ private
end record; end record;
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : Cursor); Item : Cursor);
for Cursor'Write use Write; for Cursor'Write use Write;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor); Item : out Cursor);
for Cursor'Read use Read; for Cursor'Read use Read;
...@@ -229,13 +229,13 @@ private ...@@ -229,13 +229,13 @@ private
No_Element : constant Cursor := Cursor'(null, null); No_Element : constant Cursor := Cursor'(null, null);
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : Map); Container : Map);
for Map'Write use Write; for Map'Write use Write;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : out Map); Container : out Map);
for Map'Read use Read; for Map'Read use Read;
......
gcc/ada/a-cohama.adb
...@@ -438,18 +438,10 @@ package body Ada.Containers.Hashed_Maps is ...@@ -438,18 +438,10 @@ package body Ada.Containers.Hashed_Maps is
-------------- --------------
function New_Node (Next : Node_Access) return Node_Access is function New_Node (Next : Node_Access) return Node_Access is
Node : Node_Access := new Node_Type; -- Ada 2005 aggregate possible?
begin begin
Node.Key := Key; return new Node_Type'(Key => Key,
Node.Next := Next; Element => <>,
Next => Next);
return Node;
exception
when others =>
Free (Node);
raise;
end New_Node; end New_Node;
HT : Hash_Table_Type renames Container.HT; HT : Hash_Table_Type renames Container.HT;
...@@ -490,9 +482,8 @@ package body Ada.Containers.Hashed_Maps is ...@@ -490,9 +482,8 @@ package body Ada.Containers.Hashed_Maps is
-------------- --------------
function New_Node (Next : Node_Access) return Node_Access is function New_Node (Next : Node_Access) return Node_Access is
Node : constant Node_Access := new Node_Type'(Key, New_Item, Next);
begin begin
return Node; return new Node_Type'(Key, New_Item, Next);
end New_Node; end New_Node;
HT : Hash_Table_Type renames Container.HT; HT : Hash_Table_Type renames Container.HT;
......
gcc/ada/a-cohama.ads
...@@ -212,18 +212,18 @@ private ...@@ -212,18 +212,18 @@ private
Node : Node_Access; Node : Node_Access;
end record; end record;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
Item : out Cursor); Item : out Cursor);
for Cursor'Read use Read; for Cursor'Read use Read;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
No_Element : constant Cursor := (Container => null, Node => null); No_Element : constant Cursor := (Container => null, Node => null);
end Ada.Containers.Hashed_Maps; end Ada.Containers.Hashed_Maps;
gcc/ada/a-coinve.adb
...@@ -895,6 +895,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -895,6 +895,12 @@ package body Ada.Containers.Indefinite_Vectors is
J := Target.Last; J := Target.Last;
while Source.Last >= Index_Type'First loop 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))));
if I < Index_Type'First then if I < Index_Type'First then
declare declare
Src : Elements_Type renames Src : Elements_Type renames
...@@ -909,6 +915,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -909,6 +915,12 @@ package body Ada.Containers.Indefinite_Vectors is
return; return;
end if; end if;
pragma Assert
(I <= Index_Type'First
or else not (Is_Less
(Target.Elements (I),
Target.Elements (I - 1))));
declare declare
Src : Element_Access renames Source.Elements (Source.Last); Src : Element_Access renames Source.Elements (Source.Last);
Tgt : Element_Access renames Target.Elements (I); Tgt : Element_Access renames Target.Elements (I);
......
gcc/ada/a-convec.adb
...@@ -660,6 +660,10 @@ package body Ada.Containers.Vectors is ...@@ -660,6 +660,10 @@ package body Ada.Containers.Vectors is
J := Target.Last; J := Target.Last;
while Source.Last >= Index_Type'First loop while Source.Last >= Index_Type'First loop
pragma Assert (Source.Last <= Index_Type'First
or else not (Source.Elements (Source.Last) <
Source.Elements (Source.Last - 1)));
if I < Index_Type'First then if I < Index_Type'First then
Target.Elements (Index_Type'First .. J) := Target.Elements (Index_Type'First .. J) :=
Source.Elements (Index_Type'First .. Source.Last); Source.Elements (Index_Type'First .. Source.Last);
...@@ -668,6 +672,10 @@ package body Ada.Containers.Vectors is ...@@ -668,6 +672,10 @@ package body Ada.Containers.Vectors is
return; return;
end if; end if;
pragma Assert (I <= Index_Type'First
or else not (Target.Elements (I) <
Target.Elements (I - 1)));
if Source.Elements (Source.Last) < Target.Elements (I) then if Source.Elements (Source.Last) < Target.Elements (I) then
Target.Elements (J) := Target.Elements (I); Target.Elements (J) := Target.Elements (I);
I := I - 1; I := I - 1;
...@@ -1923,7 +1931,6 @@ package body Ada.Containers.Vectors is ...@@ -1923,7 +1931,6 @@ package body Ada.Containers.Vectors is
B : Natural renames V.Busy; B : Natural renames V.Busy;
begin begin
B := B + 1; B := B + 1;
begin begin
...@@ -1937,7 +1944,6 @@ package body Ada.Containers.Vectors is ...@@ -1937,7 +1944,6 @@ package body Ada.Containers.Vectors is
end; end;
B := B - 1; B := B - 1;
end Reverse_Iterate; end Reverse_Iterate;
---------------- ----------------
......
gcc/ada/a-coorma.adb
...@@ -127,17 +127,19 @@ package body Ada.Containers.Ordered_Maps is ...@@ -127,17 +127,19 @@ package body Ada.Containers.Ordered_Maps is
function "<" (Left, Right : Cursor) return Boolean is function "<" (Left, Right : Cursor) return Boolean is
begin begin
if Left.Node = null if Left.Node = null then
or else Right.Node = null raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
then end if;
raise Constraint_Error;
if Right.Node = null then
raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in ""<"""); "Left cursor of ""<"" is bad");
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in ""<"""); "Right cursor of ""<"" is bad");
return Left.Node.Key < Right.Node.Key; return Left.Node.Key < Right.Node.Key;
end "<"; end "<";
...@@ -145,11 +147,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -145,11 +147,11 @@ package body Ada.Containers.Ordered_Maps is
function "<" (Left : Cursor; Right : Key_Type) return Boolean is function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin begin
if Left.Node = null then if Left.Node = null then
raise Constraint_Error; raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in ""<"""); "Left cursor of ""<"" is bad");
return Left.Node.Key < Right; return Left.Node.Key < Right;
end "<"; end "<";
...@@ -157,11 +159,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -157,11 +159,11 @@ package body Ada.Containers.Ordered_Maps is
function "<" (Left : Key_Type; Right : Cursor) return Boolean is function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin begin
if Right.Node = null then if Right.Node = null then
raise Constraint_Error; raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if; end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in ""<"""); "Right cursor of ""<"" is bad");
return Left < Right.Node.Key; return Left < Right.Node.Key;
end "<"; end "<";
...@@ -181,17 +183,19 @@ package body Ada.Containers.Ordered_Maps is ...@@ -181,17 +183,19 @@ package body Ada.Containers.Ordered_Maps is
function ">" (Left, Right : Cursor) return Boolean is function ">" (Left, Right : Cursor) return Boolean is
begin begin
if Left.Node = null if Left.Node = null then
or else Right.Node = null raise Constraint_Error with "Left cursor of "">"" equals No_Element";
then end if;
raise Constraint_Error;
if Right.Node = null then
raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in "">"""); "Left cursor of "">"" is bad");
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in "">"""); "Right cursor of "">"" is bad");
return Right.Node.Key < Left.Node.Key; return Right.Node.Key < Left.Node.Key;
end ">"; end ">";
...@@ -199,11 +203,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -199,11 +203,11 @@ package body Ada.Containers.Ordered_Maps is
function ">" (Left : Cursor; Right : Key_Type) return Boolean is function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin begin
if Left.Node = null then if Left.Node = null then
raise Constraint_Error; raise Constraint_Error with "Left cursor of "">"" equals No_Element";
end if; end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node), pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in "">"""); "Left cursor of "">"" is bad");
return Right < Left.Node.Key; return Right < Left.Node.Key;
end ">"; end ">";
...@@ -211,11 +215,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -211,11 +215,11 @@ package body Ada.Containers.Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean is function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin begin
if Right.Node = null then if Right.Node = null then
raise Constraint_Error; raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if; end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node), pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in "">"""); "Right cursor of "">"" is bad");
return Right.Node.Key < Left; return Right.Node.Key < Left;
end ">"; end ">";
...@@ -302,14 +306,17 @@ package body Ada.Containers.Ordered_Maps is ...@@ -302,14 +306,17 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Delete equals No_Element";
end if; end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error with
"Position cursor of Delete designates wrong map";
end if; end if;
pragma Assert (Vet (Tree, Position.Node), "bad cursor in Delete"); pragma Assert (Vet (Tree, Position.Node),
"Position cursor of Delete is bad");
Tree_Operations.Delete_Node_Sans_Free (Tree, Position.Node); Tree_Operations.Delete_Node_Sans_Free (Tree, Position.Node);
Free (Position.Node); Free (Position.Node);
...@@ -322,7 +329,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -322,7 +329,7 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if X = null then if X = null then
raise Constraint_Error; raise Constraint_Error with "key not in map";
end if; end if;
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
...@@ -364,11 +371,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -364,11 +371,12 @@ package body Ada.Containers.Ordered_Maps is
function Element (Position : Cursor) return Element_Type is function Element (Position : Cursor) return Element_Type is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of function Element equals No_Element";
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element"); "Position cursor of function Element is bad");
return Position.Node.Element; return Position.Node.Element;
end Element; end Element;
...@@ -378,7 +386,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -378,7 +386,7 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if Node = null then if Node = null then
raise Constraint_Error; raise Constraint_Error with "key not in map";
end if; end if;
return Node.Element; return Node.Element;
...@@ -452,7 +460,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -452,7 +460,7 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if T.First = null then if T.First = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.First.Element; return T.First.Element;
...@@ -467,7 +475,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -467,7 +475,7 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if T.First = null then if T.First = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.First.Key; return T.First.Key;
...@@ -534,7 +542,8 @@ package body Ada.Containers.Ordered_Maps is ...@@ -534,7 +542,8 @@ package body Ada.Containers.Ordered_Maps is
if not Inserted then if not Inserted then
if Container.Tree.Lock > 0 then if Container.Tree.Lock > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if; end if;
Position.Node.Key := Key; Position.Node.Key := Key;
...@@ -596,7 +605,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -596,7 +605,7 @@ package body Ada.Containers.Ordered_Maps is
Insert (Container, Key, New_Item, Position, Inserted); Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then if not Inserted then
raise Constraint_Error; raise Constraint_Error with "key already in map";
end if; end if;
end Insert; end Insert;
...@@ -746,11 +755,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -746,11 +755,12 @@ package body Ada.Containers.Ordered_Maps is
function Key (Position : Cursor) return Key_Type is function Key (Position : Cursor) return Key_Type is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of function Key equals No_Element";
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Key"); "Position cursor of function Key is bad");
return Position.Node.Key; return Position.Node.Key;
end Key; end Key;
...@@ -779,7 +789,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -779,7 +789,7 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if T.Last = null then if T.Last = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.Last.Element; return T.Last.Element;
...@@ -794,7 +804,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -794,7 +804,7 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if T.Last = null then if T.Last = null then
raise Constraint_Error; raise Constraint_Error with "map is empty";
end if; end if;
return T.Last.Key; return T.Last.Key;
...@@ -846,7 +856,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -846,7 +856,7 @@ package body Ada.Containers.Ordered_Maps is
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Next"); "Position cursor of Next is bad");
declare declare
Node : constant Node_Access := Node : constant Node_Access :=
...@@ -886,7 +896,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -886,7 +896,7 @@ package body Ada.Containers.Ordered_Maps is
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Previous"); "Position cursor of Previous is bad");
declare declare
Node : constant Node_Access := Node : constant Node_Access :=
...@@ -912,11 +922,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -912,11 +922,12 @@ package body Ada.Containers.Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Query_Element equals No_Element";
end if; end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node), pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Query_Element"); "Position cursor of Query_Element is bad");
declare declare
T : Tree_Type renames Position.Container.Tree; T : Tree_Type renames Position.Container.Tree;
...@@ -951,7 +962,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -951,7 +962,7 @@ package body Ada.Containers.Ordered_Maps is
---------- ----------
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : out Map) Container : out Map)
is is
function Read_Node function Read_Node
...@@ -986,11 +997,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -986,11 +997,11 @@ package body Ada.Containers.Ordered_Maps is
end Read; end Read;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor) Item : out Cursor)
is is
begin begin
raise Program_Error; raise Program_Error with "attempt to stream map cursor";
end Read; end Read;
------------- -------------
...@@ -1006,11 +1017,12 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1006,11 +1017,12 @@ package body Ada.Containers.Ordered_Maps is
begin begin
if Node = null then if Node = null then
raise Constraint_Error; raise Constraint_Error with "key not in map";
end if; end if;
if Container.Tree.Lock > 0 then if Container.Tree.Lock > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if; end if;
Node.Key := Key; Node.Key := Key;
...@@ -1028,19 +1040,22 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1028,19 +1040,22 @@ package body Ada.Containers.Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
end if; end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error with
"Position cursor of Replace_Element designates wrong map";
end if; end if;
if Container.Tree.Lock > 0 then if Container.Tree.Lock > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if; end if;
pragma Assert (Vet (Container.Tree, Position.Node), pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Replace_Element"); "Position cursor of Replace_Element is bad");
Position.Node.Element := New_Item; Position.Node.Element := New_Item;
end Replace_Element; end Replace_Element;
...@@ -1146,15 +1161,17 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1146,15 +1161,17 @@ package body Ada.Containers.Ordered_Maps is
is is
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error with
"Position cursor of Update_Element equals No_Element";
end if; end if;
if Position.Container /= Container'Unrestricted_Access then if Position.Container /= Container'Unrestricted_Access then
raise Program_Error; raise Program_Error with
"Position cursor of Update_Element designates wrong map";
end if; end if;
pragma Assert (Vet (Container.Tree, Position.Node), pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Update_Element"); "Position cursor of Update_Element is bad");
declare declare
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
...@@ -1189,7 +1206,7 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1189,7 +1206,7 @@ package body Ada.Containers.Ordered_Maps is
----------- -----------
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : Map) Container : Map)
is is
procedure Write_Node procedure Write_Node
...@@ -1220,11 +1237,11 @@ package body Ada.Containers.Ordered_Maps is ...@@ -1220,11 +1237,11 @@ package body Ada.Containers.Ordered_Maps is
end Write; end Write;
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : Cursor) Item : Cursor)
is is
begin begin
raise Program_Error; raise Program_Error with "attempt to stream map cursor";
end Write; end Write;
end Ada.Containers.Ordered_Maps; end Ada.Containers.Ordered_Maps;
gcc/ada/a-coorma.ads
...@@ -217,13 +217,13 @@ private ...@@ -217,13 +217,13 @@ private
end record; end record;
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : Cursor); Item : Cursor);
for Cursor'Write use Write; for Cursor'Write use Write;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor); Item : out Cursor);
for Cursor'Read use Read; for Cursor'Read use Read;
...@@ -231,13 +231,13 @@ private ...@@ -231,13 +231,13 @@ private
No_Element : constant Cursor := Cursor'(null, null); No_Element : constant Cursor := Cursor'(null, null);
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : Map); Container : Map);
for Map'Write use Write; for Map'Write use Write;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Container : out Map); Container : out Map);
for Map'Read use Read; for Map'Read use Read;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment