procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Matthew Heaney 2005-12-09 18:16:22 +01:00 • committed by Arnaud Charlet
parent 9582a3cd55
commit 7cdc672b77
13 changed files with 351 additions and 233 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
gcc/ada/a-cdlili.adb
View file

@ -466,11 +466,19 @@ package body Ada.Containers.Doubly_Linked_Lists is
end if;
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
Splice (Target, No_Element, Source);
return;
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
declare
RJ : Cursor := RI;
@ -1289,13 +1297,13 @@ package body Ada.Containers.Doubly_Linked_Lists is
end Splice;
procedure Splice
(Target : in out List;
Before : Cursor;
Position : Cursor)
(Container : in out List;
Before : Cursor;
Position : in out Cursor)
is
begin
if Before.Container /= null then
if Before.Container /= Target'Unchecked_Access then
if Before.Container /= Container'Unchecked_Access then
raise Program_Error;
end if;
@ -1306,7 +1314,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
raise Constraint_Error;
end if;
if Position.Container /= Target'Unrestricted_Access then
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
end if;
@ -1318,59 +1326,59 @@ package body Ada.Containers.Doubly_Linked_Lists is
return;
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;
end if;
if Before.Node = null then
pragma Assert (Position.Node /= Target.Last);
pragma Assert (Position.Node /= Container.Last);
if Position.Node = Target.First then
Target.First := Position.Node.Next;
Target.First.Prev := null;
if Position.Node = Container.First then
Container.First := Position.Node.Next;
Container.First.Prev := null;
else
Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev;
end if;
Target.Last.Next := Position.Node;
Position.Node.Prev := Target.Last;
Container.Last.Next := Position.Node;
Position.Node.Prev := Container.Last;
Target.Last := Position.Node;
Target.Last.Next := null;
Container.Last := Position.Node;
Container.Last.Next := null;
return;
end if;
if Before.Node = Target.First then
pragma Assert (Position.Node /= Target.First);
if Before.Node = Container.First then
pragma Assert (Position.Node /= Container.First);
if Position.Node = Target.Last then
Target.Last := Position.Node.Prev;
Target.Last.Next := null;
if Position.Node = Container.Last then
Container.Last := Position.Node.Prev;
Container.Last.Next := null;
else
Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev;
end if;
Target.First.Prev := Position.Node;
Position.Node.Next := Target.First;
Container.First.Prev := Position.Node;
Position.Node.Next := Container.First;
Target.First := Position.Node;
Target.First.Prev := null;
Container.First := Position.Node;
Container.First.Prev := null;
return;
end if;
if Position.Node = Target.First then
Target.First := Position.Node.Next;
Target.First.Prev := null;
if Position.Node = Container.First then
Container.First := Position.Node.Next;
Container.First.Prev := null;
elsif Position.Node = Target.Last then
Target.Last := Position.Node.Prev;
Target.Last.Next := null;
elsif Position.Node = Container.Last then
Container.Last := Position.Node.Prev;
Container.Last.Next := null;
else
Position.Node.Prev.Next := Position.Node.Next;
@ -1383,8 +1391,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
Before.Node.Prev := Position.Node;
Position.Node.Next := Before.Node;
pragma Assert (Target.First.Prev = null);
pragma Assert (Target.Last.Next = null);
pragma Assert (Container.First.Prev = null);
pragma Assert (Container.Last.Next = null);
end Splice;
procedure Splice
@ -1570,24 +1578,26 @@ package body Ada.Containers.Doubly_Linked_Lists is
declare
I_Next : constant Cursor := Next (I);
J_Copy : Cursor := J;
begin
if I_Next = J then
Splice (Container, Before => I, Position => J);
Splice (Container, Before => I, Position => J_Copy);
else
declare
J_Next : constant Cursor := Next (J);
I_Copy : Cursor := I;
begin
if J_Next = I then
Splice (Container, Before => J, Position => I);
Splice (Container, Before => J, Position => I_Copy);
else
pragma Assert (Container.Length >= 3);
Splice (Container, Before => I_Next, Position => J);
Splice (Container, Before => J_Next, Position => I);
Splice (Container, Before => I_Next, Position => J_Copy);
Splice (Container, Before => J_Next, Position => I_Copy);
end if;
end;
end if;

6
gcc/ada/a-cdlili.ads
View file

@ -145,9 +145,9 @@ package Ada.Containers.Doubly_Linked_Lists is
Position : in out Cursor);
procedure Splice
(Target : in out List;
Before : Cursor;
Position : Cursor);
(Container : in out List;
Before : Cursor;
Position : in out Cursor);
function First (Container : List) return Cursor;

83
gcc/ada/a-cidlli.adb
View file

@ -514,11 +514,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
LI := First (Target);
RI := First (Source);
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
Splice (Target, No_Element, Source);
return;
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
declare
RJ : Cursor := RI;
@ -1333,13 +1341,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
end Splice;
procedure Splice
(Target : in out List;
Before : Cursor;
Position : Cursor)
(Container : in out List;
Before : Cursor;
Position : in out Cursor)
is
begin
if Before.Container /= null then
if Before.Container /= Target'Unchecked_Access then
if Before.Container /= Container'Unchecked_Access then
raise Program_Error;
end if;
@ -1360,7 +1368,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
raise Program_Error;
end if;
if Position.Container /= Target'Unrestricted_Access then
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
end if;
@ -1372,59 +1380,59 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
return;
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;
end if;
if Before.Node = null then
pragma Assert (Position.Node /= Target.Last);
pragma Assert (Position.Node /= Container.Last);
if Position.Node = Target.First then
Target.First := Position.Node.Next;
Target.First.Prev := null;
if Position.Node = Container.First then
Container.First := Position.Node.Next;
Container.First.Prev := null;
else
Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev;
end if;
Target.Last.Next := Position.Node;
Position.Node.Prev := Target.Last;
Container.Last.Next := Position.Node;
Position.Node.Prev := Container.Last;
Target.Last := Position.Node;
Target.Last.Next := null;
Container.Last := Position.Node;
Container.Last.Next := null;
return;
end if;
if Before.Node = Target.First then
pragma Assert (Position.Node /= Target.First);
if Before.Node = Container.First then
pragma Assert (Position.Node /= Container.First);
if Position.Node = Target.Last then
Target.Last := Position.Node.Prev;
Target.Last.Next := null;
if Position.Node = Container.Last then
Container.Last := Position.Node.Prev;
Container.Last.Next := null;
else
Position.Node.Prev.Next := Position.Node.Next;
Position.Node.Next.Prev := Position.Node.Prev;
end if;
Target.First.Prev := Position.Node;
Position.Node.Next := Target.First;
Container.First.Prev := Position.Node;
Position.Node.Next := Container.First;
Target.First := Position.Node;
Target.First.Prev := null;
Container.First := Position.Node;
Container.First.Prev := null;
return;
end if;
if Position.Node = Target.First then
Target.First := Position.Node.Next;
Target.First.Prev := null;
if Position.Node = Container.First then
Container.First := Position.Node.Next;
Container.First.Prev := null;
elsif Position.Node = Target.Last then
Target.Last := Position.Node.Prev;
Target.Last.Next := null;
elsif Position.Node = Container.Last then
Container.Last := Position.Node.Prev;
Container.Last.Next := null;
else
Position.Node.Prev.Next := Position.Node.Next;
@ -1437,8 +1445,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
Before.Node.Prev := Position.Node;
Position.Node.Next := Before.Node;
pragma Assert (Target.First.Prev = null);
pragma Assert (Target.Last.Next = null);
pragma Assert (Container.First.Prev = null);
pragma Assert (Container.Last.Next = null);
end Splice;
procedure Splice
@ -1631,23 +1639,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
declare
I_Next : constant Cursor := Next (I);
J_Copy : Cursor := J;
begin
if I_Next = J then
Splice (Container, Before => I, Position => J);
Splice (Container, Before => I, Position => J_Copy);
else
declare
J_Next : constant Cursor := Next (J);
I_Copy : Cursor := I;
begin
if J_Next = I then
Splice (Container, Before => J, Position => I);
Splice (Container, Before => J, Position => I_Copy);
else
pragma Assert (Container.Length >= 3);
Splice (Container, Before => I_Next, Position => J);
Splice (Container, Before => J_Next, Position => I);
Splice (Container, Before => I_Next, Position => J_Copy);
Splice (Container, Before => J_Next, Position => I_Copy);
end if;
end;
end if;

6
gcc/ada/a-cidlli.ads
View file

@ -136,9 +136,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Position : in out Cursor);
procedure Splice
(Target : in out List;
Before : Cursor;
Position : Cursor);
(Container : in out List;
Before : Cursor;
Position : in out Cursor);
function First (Container : List) return Cursor;

46
gcc/ada/a-cihama.adb
View file

@ -237,6 +237,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
end if;
if Position.Node.Element = null then
raise Program_Error;
end if;
return Position.Node.Element.all;
end Element;
@ -267,6 +271,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
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);
end Equivalent_Keys;
@ -281,6 +291,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
end if;
if Left.Node.Key = null then
raise Program_Error;
end if;
return Equivalent_Keys (Left.Node.Key.all, Right);
end Equivalent_Keys;
@ -295,6 +309,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
end if;
if Right.Node.Key = null then
raise Program_Error;
end if;
return Equivalent_Keys (Left, Right.Node.Key.all);
end Equivalent_Keys;
@ -595,6 +613,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
end if;
if Position.Node.Key = null then
raise Program_Error;
end if;
return Position.Node.Key.all;
end Key;
@ -641,6 +663,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
return No_Element;
end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
end if;
declare
HT : Hash_Table_Type renames Position.Container.HT;
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
@ -670,6 +698,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
end if;
declare
M : Map renames Position.Container.all;
HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
@ -807,6 +841,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
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
raise Program_Error;
end if;
@ -862,6 +902,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error;
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
raise Program_Error;
end if;

169
gcc/ada/a-ciorma.adb
View file

@ -135,23 +135,27 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function "<" (Left, Right : Cursor) return Boolean is
begin
if Left.Node = null
or else Right.Node = null
then
raise Constraint_Error;
if Left.Node = null then
raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
end if;
if Left.Node.Key = null
or else Right.Node.Key = null
then
raise Program_Error;
if Right.Node = null then
raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if;
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;
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),
"bad Right cursor in ""<""");
"Right cursor in ""<"" is bad");
return Left.Node.Key.all < Right.Node.Key.all;
end "<";
@ -159,15 +163,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin
if Left.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
end if;
if Left.Node.Key = null then
raise Program_Error;
raise Program_Error with "Left cursor in ""<"" is bad";
end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in ""<""");
"Left cursor in ""<"" is bad");
return Left.Node.Key.all < Right;
end "<";
@ -175,15 +179,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin
if Right.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if;
if Right.Node.Key = null then
raise Program_Error;
raise Program_Error with "Right cursor in ""<"" is bad";
end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in ""<""");
"Right cursor in ""<"" is bad");
return Left < Right.Node.Key.all;
end "<";
@ -203,23 +207,27 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left, Right : Cursor) return Boolean is
begin
if Left.Node = null
or else Right.Node = null
then
raise Constraint_Error;
if Left.Node = null then
raise Constraint_Error with "Left cursor of "">"" equals No_Element";
end if;
if Left.Node.Key = null
or else Right.Node.Key = null
then
raise Program_Error;
if Right.Node = null then
raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if;
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;
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),
"bad Right cursor in "">""");
"Right cursor in "">"" is bad");
return Right.Node.Key.all < Left.Node.Key.all;
end ">";
@ -227,15 +235,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin
if Left.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Left cursor of "">"" equals No_Element";
end if;
if Left.Node.Key = null then
raise Program_Error;
raise Program_Error with "Left cursor in ""<"" is bad";
end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in "">""");
"Left cursor in "">"" is bad");
return Right < Left.Node.Key.all;
end ">";
@ -243,15 +251,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin
if Right.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if;
if Right.Node.Key = null then
raise Program_Error;
raise Program_Error with "Right cursor in ""<"" is bad";
end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in "">""");
"Right cursor in "">"" is bad");
return Right.Node.Key.all < Left;
end ">";
@ -346,21 +354,23 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Delete equals No_Element";
end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
raise Program_Error with "Position cursor of Delete is bad";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
raise Program_Error with
"Position cursor of Delete designates wrong map";
end if;
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);
Free (Position.Node);
@ -373,7 +383,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if X = null then
raise Constraint_Error;
raise Constraint_Error with "key not in map";
end if;
Delete_Node_Sans_Free (Container.Tree, X);
@ -415,15 +425,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Element (Position : Cursor) return Element_Type is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of function Element equals No_Element";
end if;
if Position.Node.Element = null then
raise Program_Error;
raise Program_Error with
"Position cursor of function Element is bad";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element");
"Position cursor of function Element is bad");
return Position.Node.Element.all;
end Element;
@ -433,7 +445,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if Node = null then
raise Constraint_Error;
raise Constraint_Error with "key not in map";
end if;
return Node.Element.all;
@ -507,7 +519,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if T.First = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.First.Element.all;
@ -522,7 +534,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if T.First = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.First.Key.all;
@ -619,7 +631,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
if not Inserted then
if Container.Tree.Lock > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if;
K := Position.Node.Key;
@ -706,7 +719,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then
raise Constraint_Error;
raise Constraint_Error with "key already in map";
end if;
end Insert;
@ -810,15 +823,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Key (Position : Cursor) return Key_Type is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of function Key equals No_Element";
end if;
if Position.Node.Key = null then
raise Program_Error;
raise Program_Error with
"Position cursor of function Key is bad";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Key");
"Position cursor of function Key is bad");
return Position.Node.Key.all;
end Key;
@ -847,7 +862,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if T.Last = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.Last.Element.all;
@ -862,7 +877,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if T.Last = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.Last.Key.all;
@ -912,7 +927,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
pragma Assert (Position.Node.Key /= null);
pragma Assert (Position.Node.Element /= null);
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Next");
"Position cursor of Next is bad");
declare
Node : constant Node_Access :=
@ -955,7 +970,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
pragma Assert (Position.Node.Key /= null);
pragma Assert (Position.Node.Element /= null);
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Previous");
"Position cursor of Previous is bad");
declare
Node : constant Node_Access :=
@ -986,17 +1001,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Query_Element equals No_Element";
end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
raise Program_Error with
"Position cursor of Query_Element is bad";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Query_Element");
"Position cursor of Query_Element is bad");
declare
T : Tree_Type renames Position.Container.Tree;
@ -1031,7 +1048,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
----------
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : out Map)
is
function Read_Node
@ -1066,11 +1083,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error;
raise Program_Error with "attempt to stream map cursor";
end Read;
-------------
@ -1090,11 +1107,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin
if Node = null then
raise Constraint_Error;
raise Constraint_Error with "key not in map";
end if;
if Container.Tree.Lock > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if;
K := Node.Key;
@ -1125,25 +1143,29 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
raise Program_Error with
"Position cursor of Replace_Element is bad";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
raise Program_Error with
"Position cursor of Replace_Element designates wrong map";
end if;
if Container.Tree.Lock > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Replace_Element");
"Position cursor of Replace_Element is bad");
declare
X : Element_Access := Position.Node.Element;
@ -1252,21 +1274,24 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Update_Element equals No_Element";
end if;
if Position.Node.Key = null
or else Position.Node.Element = null
then
raise Program_Error;
raise Program_Error with
"Position cursor of Update_Element is bad";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
raise Program_Error with
"Position cursor of Update_Element designates wrong map";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Update_Element");
"Position cursor of Update_Element is bad");
declare
T : Tree_Type renames Position.Container.Tree;
@ -1301,7 +1326,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
-----------
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : Map)
is
procedure Write_Node
@ -1332,11 +1357,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error;
raise Program_Error with "attempt to stream map cursor";
end Write;
end Ada.Containers.Indefinite_Ordered_Maps;

8
gcc/ada/a-ciorma.ads
View file

@ -215,13 +215,13 @@ private
end record;
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
@ -229,13 +229,13 @@ private
No_Element : constant Cursor := Cursor'(null, null);
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;

17
gcc/ada/a-cohama.adb
View file

@ -438,18 +438,10 @@ package body Ada.Containers.Hashed_Maps is
--------------
function New_Node (Next : Node_Access) return Node_Access is
Node : Node_Access := new Node_Type; -- Ada 2005 aggregate possible?
begin
Node.Key := Key;
Node.Next := Next;
return Node;
exception
when others =>
Free (Node);
raise;
return new Node_Type'(Key => Key,
Element => <>,
Next => Next);
end New_Node;
HT : Hash_Table_Type renames Container.HT;
@ -490,9 +482,8 @@ package body Ada.Containers.Hashed_Maps is
--------------
function New_Node (Next : Node_Access) return Node_Access is
Node : constant Node_Access := new Node_Type'(Key, New_Item, Next);
begin
return Node;
return new Node_Type'(Key, New_Item, Next);
end New_Node;
HT : Hash_Table_Type renames Container.HT;

12
gcc/ada/a-cohama.ads
View file

@ -212,18 +212,18 @@ private
Node : Node_Access;
end record;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
Item : out Cursor);
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);
end Ada.Containers.Hashed_Maps;

12
gcc/ada/a-coinve.adb
View file

@ -895,6 +895,12 @@ package body Ada.Containers.Indefinite_Vectors is
J := Target.Last;
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
declare
Src : Elements_Type renames
@ -909,6 +915,12 @@ package body Ada.Containers.Indefinite_Vectors is
return;
end if;
pragma Assert
(I <= Index_Type'First
or else not (Is_Less
(Target.Elements (I),
Target.Elements (I - 1))));
declare
Src : Element_Access renames Source.Elements (Source.Last);
Tgt : Element_Access renames Target.Elements (I);

10
gcc/ada/a-convec.adb
View file

@ -660,6 +660,10 @@ package body Ada.Containers.Vectors is
J := Target.Last;
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
Target.Elements (Index_Type'First .. J) :=
Source.Elements (Index_Type'First .. Source.Last);
@ -668,6 +672,10 @@ package body Ada.Containers.Vectors is
return;
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
Target.Elements (J) := Target.Elements (I);
I := I - 1;
@ -1923,7 +1931,6 @@ package body Ada.Containers.Vectors is
B : Natural renames V.Busy;
begin
B := B + 1;
begin
@ -1937,7 +1944,6 @@ package body Ada.Containers.Vectors is
end;
B := B - 1;
end Reverse_Iterate;
----------------

125
gcc/ada/a-coorma.adb
View file

@ -127,17 +127,19 @@ package body Ada.Containers.Ordered_Maps is
function "<" (Left, Right : Cursor) return Boolean is
begin
if Left.Node = null
or else Right.Node = null
then
raise Constraint_Error;
if Left.Node = null then
raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
end if;
if Right.Node = null then
raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if;
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),
"bad Right cursor in ""<""");
"Right cursor of ""<"" is bad");
return Left.Node.Key < Right.Node.Key;
end "<";
@ -145,11 +147,11 @@ package body Ada.Containers.Ordered_Maps is
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin
if Left.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in ""<""");
"Left cursor of ""<"" is bad");
return Left.Node.Key < Right;
end "<";
@ -157,11 +159,11 @@ package body Ada.Containers.Ordered_Maps is
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin
if Right.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in ""<""");
"Right cursor of ""<"" is bad");
return Left < Right.Node.Key;
end "<";
@ -181,17 +183,19 @@ package body Ada.Containers.Ordered_Maps is
function ">" (Left, Right : Cursor) return Boolean is
begin
if Left.Node = null
or else Right.Node = null
then
raise Constraint_Error;
if Left.Node = null then
raise Constraint_Error with "Left cursor of "">"" equals No_Element";
end if;
if Right.Node = null then
raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if;
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),
"bad Right cursor in "">""");
"Right cursor of "">"" is bad");
return Right.Node.Key < Left.Node.Key;
end ">";
@ -199,11 +203,11 @@ package body Ada.Containers.Ordered_Maps is
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin
if Left.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Left cursor of "">"" equals No_Element";
end if;
pragma Assert (Vet (Left.Container.Tree, Left.Node),
"bad Left cursor in "">""");
"Left cursor of "">"" is bad");
return Right < Left.Node.Key;
end ">";
@ -211,11 +215,11 @@ package body Ada.Containers.Ordered_Maps is
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin
if Right.Node = null then
raise Constraint_Error;
raise Constraint_Error with "Right cursor of "">"" equals No_Element";
end if;
pragma Assert (Vet (Right.Container.Tree, Right.Node),
"bad Right cursor in "">""");
"Right cursor of "">"" is bad");
return Right.Node.Key < Left;
end ">";
@ -302,14 +306,17 @@ package body Ada.Containers.Ordered_Maps is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Delete equals No_Element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
raise Program_Error with
"Position cursor of Delete designates wrong map";
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);
Free (Position.Node);
@ -322,7 +329,7 @@ package body Ada.Containers.Ordered_Maps is
begin
if X = null then
raise Constraint_Error;
raise Constraint_Error with "key not in map";
end if;
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@ -364,11 +371,12 @@ package body Ada.Containers.Ordered_Maps is
function Element (Position : Cursor) return Element_Type is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of function Element equals No_Element";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element");
"Position cursor of function Element is bad");
return Position.Node.Element;
end Element;
@ -378,7 +386,7 @@ package body Ada.Containers.Ordered_Maps is
begin
if Node = null then
raise Constraint_Error;
raise Constraint_Error with "key not in map";
end if;
return Node.Element;
@ -452,7 +460,7 @@ package body Ada.Containers.Ordered_Maps is
begin
if T.First = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.First.Element;
@ -467,7 +475,7 @@ package body Ada.Containers.Ordered_Maps is
begin
if T.First = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.First.Key;
@ -534,7 +542,8 @@ package body Ada.Containers.Ordered_Maps is
if not Inserted then
if Container.Tree.Lock > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if;
Position.Node.Key := Key;
@ -596,7 +605,7 @@ package body Ada.Containers.Ordered_Maps is
Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then
raise Constraint_Error;
raise Constraint_Error with "key already in map";
end if;
end Insert;
@ -746,11 +755,12 @@ package body Ada.Containers.Ordered_Maps is
function Key (Position : Cursor) return Key_Type is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of function Key equals No_Element";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Key");
"Position cursor of function Key is bad");
return Position.Node.Key;
end Key;
@ -779,7 +789,7 @@ package body Ada.Containers.Ordered_Maps is
begin
if T.Last = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.Last.Element;
@ -794,7 +804,7 @@ package body Ada.Containers.Ordered_Maps is
begin
if T.Last = null then
raise Constraint_Error;
raise Constraint_Error with "map is empty";
end if;
return T.Last.Key;
@ -846,7 +856,7 @@ package body Ada.Containers.Ordered_Maps is
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Next");
"Position cursor of Next is bad");
declare
Node : constant Node_Access :=
@ -886,7 +896,7 @@ package body Ada.Containers.Ordered_Maps is
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Previous");
"Position cursor of Previous is bad");
declare
Node : constant Node_Access :=
@ -912,11 +922,12 @@ package body Ada.Containers.Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Query_Element equals No_Element";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Query_Element");
"Position cursor of Query_Element is bad");
declare
T : Tree_Type renames Position.Container.Tree;
@ -951,7 +962,7 @@ package body Ada.Containers.Ordered_Maps is
----------
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : out Map)
is
function Read_Node
@ -986,11 +997,11 @@ package body Ada.Containers.Ordered_Maps is
end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error;
raise Program_Error with "attempt to stream map cursor";
end Read;
-------------
@ -1006,11 +1017,12 @@ package body Ada.Containers.Ordered_Maps is
begin
if Node = null then
raise Constraint_Error;
raise Constraint_Error with "key not in map";
end if;
if Container.Tree.Lock > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if;
Node.Key := Key;
@ -1028,19 +1040,22 @@ package body Ada.Containers.Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
raise Program_Error with
"Position cursor of Replace_Element designates wrong map";
end if;
if Container.Tree.Lock > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with cursors (map is locked)";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Replace_Element");
"Position cursor of Replace_Element is bad");
Position.Node.Element := New_Item;
end Replace_Element;
@ -1146,15 +1161,17 @@ package body Ada.Containers.Ordered_Maps is
is
begin
if Position.Node = null then
raise Constraint_Error;
raise Constraint_Error with
"Position cursor of Update_Element equals No_Element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
raise Program_Error with
"Position cursor of Update_Element designates wrong map";
end if;
pragma Assert (Vet (Container.Tree, Position.Node),
"bad cursor in Update_Element");
"Position cursor of Update_Element is bad");
declare
T : Tree_Type renames Container.Tree;
@ -1189,7 +1206,7 @@ package body Ada.Containers.Ordered_Maps is
-----------
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : Map)
is
procedure Write_Node
@ -1220,11 +1237,11 @@ package body Ada.Containers.Ordered_Maps is
end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error;
raise Program_Error with "attempt to stream map cursor";
end Write;
end Ada.Containers.Ordered_Maps;

8
gcc/ada/a-coorma.ads
View file

@ -217,13 +217,13 @@ private
end record;
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
@ -231,13 +231,13 @@ private
No_Element : constant Cursor := Cursor'(null, null);
procedure Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;