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 179 additions and 103 deletions
gcc/ada/a-cdlili.adb
......@@ -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;
(Container : in out List;
Before : Cursor;
Position : 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;
......
gcc/ada/a-cdlili.ads
......@@ -145,9 +145,9 @@ package Ada.Containers.Doubly_Linked_Lists is
Position : in out Cursor);
procedure Splice
(Target : in out List;
(Container : in out List;
Before : Cursor;
Position : Cursor);
Position : in out 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
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;
(Container : in out List;
Before : Cursor;
Position : 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;
......
gcc/ada/a-cidlli.ads
......@@ -136,9 +136,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Position : in out Cursor);
procedure Splice
(Target : in out List;
(Container : in out List;
Before : Cursor;
Position : Cursor);
Position : in out Cursor);
function First (Container : List) return Cursor;
......
gcc/ada/a-cihama.adb
......@@ -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;
......
gcc/ada/a-ciorma.ads
......@@ -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;
......
gcc/ada/a-cohama.adb
......@@ -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;
......
gcc/ada/a-cohama.ads
......@@ -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;
gcc/ada/a-coinve.adb
......@@ -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);
......
gcc/ada/a-convec.adb
......@@ -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;
----------------
......
gcc/ada/a-coorma.ads
......@@ -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;
......
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