diff options
author | Matthew Heaney <heaney@adacore.com> | 2005-06-16 10:56:24 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-06-16 10:56:24 +0200 |
commit | 8704d4b30e3eace58fc9506cf3533b15835c784a (patch) | |
tree | 60bbc3a40631ce4a825ff74330cd04720cf0d624 /gcc/ada/a-cidlli.adb | |
parent | dc8f57914cb54a209cf2d52bb04d21502990842b (diff) | |
download | gcc-8704d4b30e3eace58fc9506cf3533b15835c784a.zip gcc-8704d4b30e3eace58fc9506cf3533b15835c784a.tar.gz gcc-8704d4b30e3eace58fc9506cf3533b15835c784a.tar.bz2 |
a-swunha.ads, [...]: Removed.
2005-06-14 Matthew Heaney <heaney@adacore.com>
* a-swunha.ads, a-swunha.adb: Removed. Replaced by a-swuwha.ad[sb]
* a-swuwha.ads, a-swuwha.adb: New files
* a-szunha.ads, a-szunha.adb: Removed, replaced by a-szuzha.ad[sb]
* a-szuzha.ads, a-szuzha.adb: New files.
* a-rbtgso.adb, a-crbtgo.ads, a-crbtgo.adb, a-crbtgk.ads,
a-crbtgk.adb, a-crbltr.ads, a-coorse.ads, a-coorse.adb, a-convec.ads,
a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohata.ads, a-cohama.ads,
a-cohama.adb, a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb,
a-cidlli.ads, a-cidlli.adb, a-chtgop.ads, a-chtgop.adb, a-cdlili.ads,
a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb,
a-cohase.ads, a-ciorma.ads, a-coorma.ads, a-ciormu.ads, a-coormu.ads,
a-swunha.adb, a-stunha.adb, a-ciorma.adb, a-coorma.adb, a-shcain.ads,
a-shcain.adb, a-chtgke.ads, a-chtgke.adb, a-stwiha.ads, a-stwiha.adb,
a-strhas.adb, a-stzhas.adb: synchronized to the latest version of the
Ada 2005 RM.
From-SVN: r101069
Diffstat (limited to 'gcc/ada/a-cidlli.adb')
-rw-r--r-- | gcc/ada/a-cidlli.adb | 1259 |
1 files changed, 941 insertions, 318 deletions
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index 252b64f..6fb6d9e 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -2,11 +2,12 @@ -- -- -- GNAT LIBRARY COMPONENTS -- -- -- --- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS -- +-- A D A . C O N T A I N E R S . -- +-- I N D E F I N I T E _ D O U B L Y _ L I N K E D _ L I S T S -- -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -48,10 +49,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is -- Local Subprograms -- ----------------------- - procedure Delete_Node - (Container : in out List; - Node : in out Node_Access); - procedure Insert_Internal (Container : in out List; Before : Node_Access; @@ -77,15 +74,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is L := Left.First; R := Right.First; for J in 1 .. Left.Length loop - if L.Element = null then - if R.Element /= null then - return False; - end if; - - elsif R.Element = null then - return False; - - elsif L.Element.all /= R.Element.all then + if L.Element.all /= R.Element.all then return False; end if; @@ -108,6 +97,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is if Src = null then pragma Assert (Container.Last = null); pragma Assert (Container.Length = 0); + pragma Assert (Container.Busy = 0); + pragma Assert (Container.Lock = 0); return; end if; @@ -118,41 +109,40 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Container.First := null; Container.Last := null; Container.Length := 0; + Container.Busy := 0; + Container.Lock := 0; - Dst := new Node_Type'(null, null, null); + declare + Element : Element_Access := new Element_Type'(Src.Element.all); + begin + Dst := new Node_Type'(Element, null, null); + exception + when others => + Free (Element); + raise; + end; - if Src.Element /= null then + Container.First := Dst; + Container.Last := Dst; + Container.Length := 1; + + Src := Src.Next; + while Src /= null loop + declare + Element : Element_Access := new Element_Type'(Src.Element.all); begin - Dst.Element := new Element_Type'(Src.Element.all); + Dst := new Node_Type'(Element, null, Prev => Container.Last); exception when others => - Free (Dst); + Free (Element); raise; end; - end if; - - Container.First := Dst; - - Container.Last := Dst; - loop - Container.Length := Container.Length + 1; - Src := Src.Next; - exit when Src = null; - - Dst := new Node_Type'(null, Prev => Container.Last, Next => null); - - if Src.Element /= null then - begin - Dst.Element := new Element_Type'(Src.Element.all); - exception - when others => - Free (Dst); - raise; - end; - end if; Container.Last.Next := Dst; Container.Last := Dst; + Container.Length := Container.Length + 1; + + Src := Src.Next; end loop; end Adjust; @@ -174,8 +164,63 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ----------- procedure Clear (Container : in out List) is + X : Node_Access; + begin - Delete_Last (Container, Count => Container.Length); + if Container.Length = 0 then + pragma Assert (Container.First = null); + pragma Assert (Container.Last = null); + pragma Assert (Container.Busy = 0); + pragma Assert (Container.Lock = 0); + return; + end if; + + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + if Container.Busy > 0 then + raise Program_Error; + end if; + + while Container.Length > 1 loop + X := Container.First; + pragma Assert (X.Next.Prev = Container.First); + + Container.First := X.Next; + Container.First.Prev := null; + Container.Length := Container.Length - 1; + + X.Next := null; -- prevent mischief + + begin + Free (X.Element); + exception + when others => + X.Element := null; + Free (X); + raise; + end; + + Free (X); + end loop; + + X := Container.First; + pragma Assert (X = Container.Last); + + Container.First := null; + Container.Last := null; + Container.Length := 0; + + begin + Free (X.Element); + exception + when others => + X.Element := null; + Free (X); + raise; + end; + + Free (X); end Clear; -------------- @@ -198,22 +243,88 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Position : in out Cursor; Count : Count_Type := 1) is + X : Node_Access; + begin - if Position = No_Element then - return; + if Position.Node = null then + raise Constraint_Error; end if; if Position.Container /= List_Access'(Container'Unchecked_Access) then raise Program_Error; end if; + pragma Assert (Container.Length > 0); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Container.Last); + + if Position.Node = Container.First then + Delete_First (Container, Count); + Position := First (Container); + return; + end if; + + if Count = 0 then + return; + end if; + + if Container.Busy > 0 then + raise Program_Error; + end if; + for Index in 1 .. Count loop - Delete_Node (Container, Position.Node); + X := Position.Node; + Container.Length := Container.Length - 1; + + if X = Container.Last then + Position := No_Element; - if Position.Node = null then - Position.Container := null; + Container.Last := X.Prev; + Container.Last.Next := null; + + X.Prev := null; -- prevent mischief + + begin + Free (X.Element); + exception + when others => + X.Element := null; + Free (X); + raise; + end; + + Free (X); return; end if; + + Position.Node := X.Next; + + X.Next.Prev := X.Prev; + X.Prev.Next := X.Next; + + X.Prev := null; + X.Next := null; + + begin + Free (X.Element); + exception + when others => + X.Element := null; + Free (X); + raise; + end; + + Free (X); end loop; end Delete; @@ -225,10 +336,43 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : in out List; Count : Count_Type := 1) is - Node : Node_Access := Container.First; + X : Node_Access; + begin - for J in 1 .. Count_Type'Min (Count, Container.Length) loop - Delete_Node (Container, Node); + if Count >= Container.Length then + Clear (Container); + return; + end if; + + if Count = 0 then + return; + end if; + + if Container.Busy > 0 then + raise Program_Error; + end if; + + for I in 1 .. Count loop + X := Container.First; + pragma Assert (X.Next.Prev = Container.First); + + Container.First := X.Next; + Container.First.Prev := null; + + Container.Length := Container.Length - 1; + + X.Next := null; -- prevent mischief + + begin + Free (X.Element); + exception + when others => + X.Element := null; + Free (X); + raise; + end; + + Free (X); end loop; end Delete_First; @@ -240,57 +384,45 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : in out List; Count : Count_Type := 1) is - Node : Node_Access; - begin - for J in 1 .. Count_Type'Min (Count, Container.Length) loop - Node := Container.Last; - Delete_Node (Container, Node); - end loop; - end Delete_Last; - - ----------------- - -- Delete_Node -- - ----------------- - - procedure Delete_Node - (Container : in out List; - Node : in out Node_Access) - is - X : Node_Access := Node; + X : Node_Access; begin - Node := X.Next; - Container.Length := Container.Length - 1; + if Count >= Container.Length then + Clear (Container); + return; + end if; - if X = Container.First then - Container.First := X.Next; + if Count = 0 then + return; + end if; - if X = Container.Last then - pragma Assert (Container.First = null); - pragma Assert (Container.Length = 0); - Container.Last := null; - else - pragma Assert (Container.Length > 0); - Container.First.Prev := null; - end if; + if Container.Busy > 0 then + raise Program_Error; + end if; - elsif X = Container.Last then - pragma Assert (Container.Length > 0); + for I in 1 .. Count loop + X := Container.Last; + pragma Assert (X.Prev.Next = Container.Last); Container.Last := X.Prev; Container.Last.Next := null; - else - pragma Assert (Container.Length > 0); + Container.Length := Container.Length - 1; - X.Next.Prev := X.Prev; - X.Prev.Next := X.Next; + X.Prev := null; -- prevent mischief - end if; + begin + Free (X.Element); + exception + when others => + X.Element := null; + Free (X); + raise; + end; - Free (X.Element); - Free (X); - end Delete_Node; + Free (X); + end loop; + end Delete_Last; ------------- -- Element -- @@ -298,6 +430,22 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Element (Position : Cursor) return Element_Type is begin + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node /= null); + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + return Position.Node.Element.all; end Element; @@ -315,14 +463,29 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin if Node = null then Node := Container.First; - elsif Position.Container /= List_Access'(Container'Unchecked_Access) then - raise Program_Error; + + else + if Position.Container /= List_Access'(Container'Unchecked_Access) then + raise Program_Error; + end if; + + pragma Assert (Container.Length > 0); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Container.Last); end if; while Node /= null loop - if Node.Element /= null - and then Node.Element.all = Item - then + if Node.Element.all = Item then return Cursor'(Container'Unchecked_Access, Node); end if; @@ -354,135 +517,168 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return Container.First.Element.all; end First_Element; - ------------------- - -- Generic_Merge -- - ------------------- + --------------------- + -- Generic_Sorting -- + --------------------- - procedure Generic_Merge - (Target : in out List; - Source : in out List) - is - LI : Cursor; - RI : Cursor; + package body Generic_Sorting is - begin - if Target'Address = Source'Address then - return; - end if; + --------------- + -- Is_Sorted -- + --------------- + + function Is_Sorted (Container : List) return Boolean is + Node : Node_Access := Container.First; + + begin + for I in 2 .. Container.Length loop + if Node.Next.Element.all < Node.Element.all then + return False; + end if; + + Node := Node.Next; + end loop; + + return True; + end Is_Sorted; + + ----------- + -- Merge -- + ----------- - LI := First (Target); - RI := First (Source); - while RI.Node /= null loop - if LI.Node = null then - Splice (Target, No_Element, Source); + procedure Merge + (Target : in out List; + Source : in out List) + is + LI : Cursor; + RI : Cursor; + + begin + if Target'Address = Source'Address then return; end if; - if LI.Node.Element = null then - LI.Node := LI.Node.Next; - - elsif RI.Node.Element = null - or else RI.Node.Element.all < LI.Node.Element.all + if Target.Busy > 0 + or else Source.Busy > 0 then - declare - RJ : constant Cursor := RI; - begin - RI.Node := RI.Node.Next; - Splice (Target, LI, Source, RJ); - end; - - else - LI.Node := LI.Node.Next; + raise Program_Error; end if; - end loop; - end Generic_Merge; - ------------------ - -- Generic_Sort -- - ------------------ + LI := First (Target); + RI := First (Source); + while RI.Node /= null loop + if LI.Node = null then + Splice (Target, No_Element, Source); + return; + end if; - procedure Generic_Sort (Container : in out List) is - procedure Partition (Pivot : Node_Access; Back : Node_Access); + if RI.Node.Element.all < LI.Node.Element.all then + declare + RJ : Cursor := RI; + begin + RI.Node := RI.Node.Next; + Splice (Target, LI, Source, RJ); + end; - procedure Sort (Front, Back : Node_Access); + else + LI.Node := LI.Node.Next; + end if; + end loop; + end Merge; - --------------- - -- Partition -- - --------------- + ---------- + -- Sort -- + ---------- - procedure Partition (Pivot : Node_Access; Back : Node_Access) is - Node : Node_Access := Pivot.Next; + procedure Sort (Container : in out List) is + procedure Partition (Pivot : Node_Access; Back : Node_Access); - begin - while Node /= Back loop - if Pivot.Element = null then - Node := Node.Next; + procedure Sort (Front, Back : Node_Access); - elsif Node.Element = null - or else Node.Element.all < Pivot.Element.all - then - declare - Prev : constant Node_Access := Node.Prev; - Next : constant Node_Access := Node.Next; - begin - Prev.Next := Next; + --------------- + -- Partition -- + --------------- - if Next = null then - Container.Last := Prev; - else - Next.Prev := Prev; - end if; + procedure Partition (Pivot : Node_Access; Back : Node_Access) is + Node : Node_Access := Pivot.Next; - Node.Next := Pivot; - Node.Prev := Pivot.Prev; + begin + while Node /= Back loop + if Node.Element.all < Pivot.Element.all then + declare + Prev : constant Node_Access := Node.Prev; + Next : constant Node_Access := Node.Next; + begin + Prev.Next := Next; + + if Next = null then + Container.Last := Prev; + else + Next.Prev := Prev; + end if; + + Node.Next := Pivot; + Node.Prev := Pivot.Prev; + + Pivot.Prev := Node; + + if Node.Prev = null then + Container.First := Node; + else + Node.Prev.Next := Node; + end if; + + Node := Next; + end; - Pivot.Prev := Node; + else + Node := Node.Next; + end if; + end loop; + end Partition; - if Node.Prev = null then - Container.First := Node; - else - Node.Prev.Next := Node; - end if; + ---------- + -- Sort -- + ---------- - Node := Next; - end; + procedure Sort (Front, Back : Node_Access) is + Pivot : Node_Access; + begin + if Front = null then + Pivot := Container.First; else - Node := Node.Next; + Pivot := Front.Next; end if; - end loop; - end Partition; - ---------- - -- Sort -- - ---------- + if Pivot /= Back then + Partition (Pivot, Back); + Sort (Front, Pivot); + Sort (Pivot, Back); + end if; + end Sort; - procedure Sort (Front, Back : Node_Access) is - Pivot : Node_Access; + -- Start of processing for Sort begin - if Front = null then - Pivot := Container.First; - else - Pivot := Front.Next; + if Container.Length <= 1 then + return; end if; - if Pivot /= Back then - Partition (Pivot, Back); - Sort (Front, Pivot); - Sort (Pivot, Back); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + if Container.Busy > 0 then + raise Program_Error; end if; - end Sort; - -- Start of processing for Generic_Sort + Sort (Front => null, Back => null); - begin - Sort (Front => null, Back => null); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + end Sort; - pragma Assert (Container.Length = 0 - or else (Container.First.Prev = null - and Container.Last.Next = null)); - end Generic_Sort; + end Generic_Sorting; ----------------- -- Has_Element -- @@ -490,7 +686,27 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Has_Element (Position : Cursor) return Boolean is begin - return Position.Container /= null and then Position.Node /= null; + if Position.Node = null then + pragma Assert (Position.Container = null); + return False; + end if; + + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + + return True; end Has_Element; ------------ @@ -507,10 +723,24 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is New_Node : Node_Access; begin - if Before.Container /= null - and then Before.Container /= List_Access'(Container'Unchecked_Access) - then - raise Program_Error; + if Before.Node /= null then + if Before.Container /= List_Access'(Container'Unchecked_Access) then + raise Program_Error; + end if; + + pragma Assert (Container.Length > 0); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + pragma Assert (Before.Node.Element /= null); + pragma Assert (Before.Node.Prev = null + or else Before.Node.Prev.Next = Before.Node); + pragma Assert (Before.Node.Next = null + or else Before.Node.Next.Prev = Before.Node); + pragma Assert (Before.Node.Prev /= null + or else Before.Node = Container.First); + pragma Assert (Before.Node.Next /= null + or else Before.Node = Container.Last); end if; if Count = 0 then @@ -518,6 +748,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return; end if; + if Container.Length > Count_Type'Last - Count then + raise Constraint_Error; + end if; + + if Container.Busy > 0 then + raise Program_Error; + end if; + declare Element : Element_Access := new Element_Type'(New_Item); begin @@ -529,7 +767,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end; Insert_Internal (Container, Before.Node, New_Node); - Position := Cursor'(Before.Container, New_Node); + Position := Cursor'(Container'Unchecked_Access, New_Node); for J in Count_Type'(2) .. Count loop @@ -623,12 +861,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : List; Process : not null access procedure (Position : in Cursor)) is + C : List renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + Node : Node_Access := Container.First; + begin - while Node /= null loop - Process (Cursor'(Container'Unchecked_Access, Node)); - Node := Node.Next; - end loop; + B := B + 1; + + begin + while Node /= null loop + Process (Cursor'(Container'Unchecked_Access, Node)); + Node := Node.Next; + end loop; + exception + when others => + B := B - 1; + raise; + end; + + B := B - 1; end Iterate; ---------- @@ -641,10 +893,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return; end if; - if Target.Length > 0 then - raise Constraint_Error; + if Source.Busy > 0 then + raise Program_Error; end if; + Clear (Target); + Target.First := Source.First; Source.First := null; @@ -693,9 +947,25 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Next (Position : in out Cursor) is begin if Position.Node = null then + pragma Assert (Position.Container = null); return; end if; + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + Position.Node := Position.Node.Next; if Position.Node = null then @@ -706,9 +976,25 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Next (Position : Cursor) return Cursor is begin if Position.Node = null then + pragma Assert (Position.Container = null); return No_Element; end if; + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + declare Next_Node : constant Node_Access := Position.Node.Next; begin @@ -740,9 +1026,25 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Previous (Position : in out Cursor) is begin if Position.Node = null then + pragma Assert (Position.Container = null); return; end if; + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + Position.Node := Position.Node.Prev; if Position.Node = null then @@ -753,9 +1055,25 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Previous (Position : Cursor) return Cursor is begin if Position.Node = null then + pragma Assert (Position.Container = null); return No_Element; end if; + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + declare Prev_Node : constant Node_Access := Position.Node.Prev; begin @@ -775,8 +1093,43 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Position : Cursor; Process : not null access procedure (Element : in Element_Type)) is + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node /= null); + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + + E : Element_Type renames Position.Node.Element.all; + + C : List renames Position.Container.all'Unrestricted_Access.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin - Process (Position.Node.Element.all); + B := B + 1; + L := L + 1; + + begin + Process (E); + exception + when others => + L := L - 1; + B := B - 1; + raise; + end; + + L := L - 1; + B := B - 1; end Query_Element; ---------- @@ -787,11 +1140,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Stream : access Root_Stream_Type'Class; Item : out List) is - N : Count_Type'Base; - X : Node_Access; + N : Count_Type'Base; + Dst : Node_Access; begin - Clear (Item); -- ??? + Clear (Item); Count_Type'Base'Read (Stream, N); @@ -799,36 +1152,36 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return; end if; - X := new Node_Type; - + declare + Element : Element_Access := + new Element_Type'(Element_Type'Input (Stream)); begin - X.Element := new Element_Type'(Element_Type'Input (Stream)); + Dst := new Node_Type'(Element, null, null); exception when others => - Free (X); + Free (Element); raise; end; - Item.First := X; - - Item.Last := X; - loop - Item.Length := Item.Length + 1; - exit when Item.Length = N; - - X := new Node_Type; + Item.First := Dst; + Item.Last := Dst; + Item.Length := 1; + while Item.Length < N loop + declare + Element : Element_Access := + new Element_Type'(Element_Type'Input (Stream)); begin - X.Element := new Element_Type'(Element_Type'Input (Stream)); + Dst := new Node_Type'(Element, Next => null, Prev => Item.Last); exception when others => - Free (X); + Free (Element); raise; end; - X.Prev := Item.Last; - Item.Last.Next := X; - Item.Last := X; + Item.Last.Next := Dst; + Item.Last := Dst; + Item.Length := Item.Length + 1; end loop; end Read; @@ -840,8 +1193,29 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Position : Cursor; By : Element_Type) is + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node /= null); + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + X : Element_Access := Position.Node.Element; + begin + if Position.Container.Lock > 0 then + raise Program_Error; + end if; + Position.Node.Element := new Element_Type'(By); Free (X); end Replace_Element; @@ -860,14 +1234,29 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin if Node = null then Node := Container.Last; - elsif Position.Container /= List_Access'(Container'Unchecked_Access) then - raise Program_Error; + + else + if Position.Container /= List_Access'(Container'Unchecked_Access) then + raise Program_Error; + end if; + + pragma Assert (Container.Length > 0); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Container.Last); end if; while Node /= null loop - if Node.Element /= null - and then Node.Element.all = Item - then + if Node.Element.all = Item then return Cursor'(Container'Unchecked_Access, Node); end if; @@ -885,13 +1274,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : List; Process : not null access procedure (Position : in Cursor)) is + C : List renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + Node : Node_Access := Container.Last; begin - while Node /= null loop - Process (Cursor'(Container'Unchecked_Access, Node)); - Node := Node.Prev; - end loop; + B := B + 1; + + begin + while Node /= null loop + Process (Cursor'(Container'Unchecked_Access, Node)); + Node := Node.Prev; + end loop; + exception + when others => + B := B - 1; + raise; + end; + + B := B - 1; end Reverse_Iterate; ------------------ @@ -949,6 +1351,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return; end if; + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + if Container.Busy > 0 then + raise Program_Error; + end if; + Container.First := J; Container.Last := I; loop @@ -983,10 +1392,24 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Source : in out List) is begin - if Before.Container /= null - and then Before.Container /= List_Access'(Target'Unchecked_Access) - then - raise Program_Error; + if Before.Node /= null then + if Before.Container /= List_Access'(Target'Unchecked_Access) then + raise Program_Error; + end if; + + pragma Assert (Target.Length >= 1); + pragma Assert (Target.First.Prev = null); + pragma Assert (Target.Last.Next = null); + + pragma Assert (Before.Node.Element /= null); + pragma Assert (Before.Node.Prev = null + or else Before.Node.Prev.Next = Before.Node); + pragma Assert (Before.Node.Next = null + or else Before.Node.Next.Prev = Before.Node); + pragma Assert (Before.Node.Prev /= null + or else Before.Node = Target.First); + pragma Assert (Before.Node.Next /= null + or else Before.Node = Target.Last); end if; if Target'Address = Source'Address @@ -995,8 +1418,23 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return; end if; + pragma Assert (Source.First.Prev = null); + pragma Assert (Source.Last.Next = null); + + if Target.Length > Count_Type'Last - Source.Length then + raise Constraint_Error; + end if; + + if Target.Busy > 0 + or else Source.Busy > 0 + then + raise Program_Error; + end if; + if Target.Length = 0 then pragma Assert (Before = No_Element); + pragma Assert (Target.First = null); + pragma Assert (Target.Last = null); Target.First := Source.First; Target.Last := Source.Last; @@ -1018,6 +1456,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Target.First := Source.First; else + pragma Assert (Target.Length >= 2); Before.Node.Prev.Next := Source.First; Source.First.Prev := Before.Node.Prev; @@ -1037,141 +1476,207 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Before : Cursor; Position : Cursor) is - X : Node_Access := Position.Node; - begin - if Before.Container /= null - and then Before.Container /= List_Access'(Target'Unchecked_Access) - then - raise Program_Error; + if Before.Node /= null then + if Before.Container /= List_Access'(Target'Unchecked_Access) then + raise Program_Error; + end if; + + pragma Assert (Target.Length >= 1); + pragma Assert (Target.First.Prev = null); + pragma Assert (Target.Last.Next = null); + + pragma Assert (Before.Node.Element /= null); + pragma Assert (Before.Node.Prev = null + or else Before.Node.Prev.Next = Before.Node); + pragma Assert (Before.Node.Next = null + or else Before.Node.Next.Prev = Before.Node); + pragma Assert (Before.Node.Prev /= null + or else Before.Node = Target.First); + pragma Assert (Before.Node.Next /= null + or else Before.Node = Target.Last); end if; - if Position.Container /= null - and then Position.Container /= List_Access'(Target'Unchecked_Access) - then + if Position.Node = null then + raise Constraint_Error; + end if; + + if Position.Container /= List_Access'(Target'Unchecked_Access) then raise Program_Error; end if; - if X = null - or else X = Before.Node - or else X.Next = Before.Node + pragma Assert (Target.Length >= 1); + pragma Assert (Target.First.Prev = null); + pragma Assert (Target.Last.Next = null); + + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Target.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Target.Last); + + if Position.Node = Before.Node + or else Position.Node.Next = Before.Node then return; end if; - pragma Assert (Target.Length > 0); + pragma Assert (Target.Length >= 2); + + if Target.Busy > 0 then + raise Program_Error; + end if; if Before.Node = null then - pragma Assert (X /= Target.Last); + pragma Assert (Position.Node /= Target.Last); - if X = Target.First then - Target.First := X.Next; + if Position.Node = Target.First then + Target.First := Position.Node.Next; Target.First.Prev := null; else - X.Prev.Next := X.Next; - X.Next.Prev := X.Prev; + Position.Node.Prev.Next := Position.Node.Next; + Position.Node.Next.Prev := Position.Node.Prev; end if; - Target.Last.Next := X; - X.Prev := Target.Last; + Target.Last.Next := Position.Node; + Position.Node.Prev := Target.Last; - Target.Last := X; + Target.Last := Position.Node; Target.Last.Next := null; return; end if; if Before.Node = Target.First then - pragma Assert (X /= Target.First); + pragma Assert (Position.Node /= Target.First); - if X = Target.Last then - Target.Last := X.Prev; + if Position.Node = Target.Last then + Target.Last := Position.Node.Prev; Target.Last.Next := null; else - X.Prev.Next := X.Next; - X.Next.Prev := X.Prev; + Position.Node.Prev.Next := Position.Node.Next; + Position.Node.Next.Prev := Position.Node.Prev; end if; - Target.First.Prev := X; - X.Next := Target.First; + Target.First.Prev := Position.Node; + Position.Node.Next := Target.First; - Target.First := X; + Target.First := Position.Node; Target.First.Prev := null; return; end if; - if X = Target.First then - Target.First := X.Next; + if Position.Node = Target.First then + Target.First := Position.Node.Next; Target.First.Prev := null; - elsif X = Target.Last then - Target.Last := X.Prev; + elsif Position.Node = Target.Last then + Target.Last := Position.Node.Prev; Target.Last.Next := null; else - X.Prev.Next := X.Next; - X.Next.Prev := X.Prev; + Position.Node.Prev.Next := Position.Node.Next; + Position.Node.Next.Prev := Position.Node.Prev; end if; - Before.Node.Prev.Next := X; - X.Prev := Before.Node.Prev; + Before.Node.Prev.Next := Position.Node; + Position.Node.Prev := Before.Node.Prev; + + Before.Node.Prev := Position.Node; + Position.Node.Next := Before.Node; - Before.Node.Prev := X; - X.Next := Before.Node; + pragma Assert (Target.First.Prev = null); + pragma Assert (Target.Last.Next = null); end Splice; procedure Splice (Target : in out List; Before : Cursor; Source : in out List; - Position : Cursor) + Position : in out Cursor) is - X : Node_Access := Position.Node; - begin if Target'Address = Source'Address then Splice (Target, Before, Position); return; end if; - if Before.Container /= null - and then Before.Container /= List_Access'(Target'Unchecked_Access) - then - raise Program_Error; + if Before.Node /= null then + if Before.Container /= List_Access'(Target'Unchecked_Access) then + raise Program_Error; + end if; + + pragma Assert (Target.Length >= 1); + pragma Assert (Target.First.Prev = null); + pragma Assert (Target.Last.Next = null); + + pragma Assert (Before.Node.Element /= null); + pragma Assert (Before.Node.Prev = null + or else Before.Node.Prev.Next = Before.Node); + pragma Assert (Before.Node.Next = null + or else Before.Node.Next.Prev = Before.Node); + pragma Assert (Before.Node.Prev /= null + or else Before.Node = Target.First); + pragma Assert (Before.Node.Next /= null + or else Before.Node = Target.Last); end if; - if Position.Container /= null - and then Position.Container /= List_Access'(Source'Unchecked_Access) - then - raise Program_Error; + if Position.Node = null then + raise Constraint_Error; end if; - if X = null then - return; + if Position.Container /= List_Access'(Source'Unchecked_Access) then + raise Program_Error; end if; - pragma Assert (Source.Length > 0); + pragma Assert (Source.Length >= 1); pragma Assert (Source.First.Prev = null); pragma Assert (Source.Last.Next = null); - if X = Source.First then - Source.First := X.Next; + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Source.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Source.Last); + + if Target.Length = Count_Type'Last then + raise Constraint_Error; + end if; + + if Target.Busy > 0 + or else Source.Busy > 0 + then + raise Program_Error; + end if; + + if Position.Node = Source.First then + Source.First := Position.Node.Next; Source.First.Prev := null; - if X = Source.Last then + if Position.Node = Source.Last then pragma Assert (Source.First = null); pragma Assert (Source.Length = 1); Source.Last := null; end if; - elsif X = Source.Last then - Source.Last := X.Prev; + elsif Position.Node = Source.Last then + pragma Assert (Source.Length >= 2); + Source.Last := Position.Node.Prev; Source.Last.Next := null; else - X.Prev.Next := X.Next; - X.Next.Prev := X.Prev; + pragma Assert (Source.Length >= 3); + Position.Node.Prev.Next := Position.Node.Next; + Position.Node.Next.Prev := Position.Node.Prev; end if; if Target.Length = 0 then @@ -1179,33 +1684,41 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Target.First = null); pragma Assert (Target.Last = null); - Target.First := X; - Target.Last := X; + Target.First := Position.Node; + Target.Last := Position.Node; + + Target.First.Prev := null; + Target.Last.Next := null; elsif Before.Node = null then - Target.Last.Next := X; - X.Next := Target.Last; + pragma Assert (Target.Last.Next = null); + Target.Last.Next := Position.Node; + Position.Node.Prev := Target.Last; - Target.Last := X; + Target.Last := Position.Node; Target.Last.Next := null; elsif Before.Node = Target.First then - Target.First.Prev := X; - X.Next := Target.First; + pragma Assert (Target.First.Prev = null); + Target.First.Prev := Position.Node; + Position.Node.Next := Target.First; - Target.First := X; + Target.First := Position.Node; Target.First.Prev := null; else - Before.Node.Prev.Next := X; - X.Prev := Before.Node.Prev; + pragma Assert (Target.Length >= 2); + Before.Node.Prev.Next := Position.Node; + Position.Node.Prev := Before.Node.Prev; - Before.Node.Prev := X; - X.Next := Before.Node; + Before.Node.Prev := Position.Node; + Position.Node.Next := Before.Node; end if; Target.Length := Target.Length + 1; Source.Length := Source.Length - 1; + + Position.Container := Target'Unchecked_Access; end Splice; ---------- @@ -1213,15 +1726,62 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ---------- procedure Swap (I, J : Cursor) is + begin + if I.Container = null + or else J.Container = null + then + raise Constraint_Error; + end if; - -- Is this op legal when I and J designate elements in different - -- containers, or should it raise an exception (e.g. Program_Error). + if I.Container /= J.Container then + raise Program_Error; + end if; - EI : constant Element_Access := I.Node.Element; + declare + C : List renames I.Container.all; + begin + pragma Assert (C.Length > 0); + pragma Assert (C.First.Prev = null); + pragma Assert (C.Last.Next = null); + + pragma Assert (I.Node /= null); + pragma Assert (I.Node.Element /= null); + pragma Assert (I.Node.Prev = null + or else I.Node.Prev.Next = I.Node); + pragma Assert (I.Node.Next = null + or else I.Node.Next.Prev = I.Node); + pragma Assert (I.Node.Prev /= null + or else I.Node = C.First); + pragma Assert (I.Node.Next /= null + or else I.Node = C.Last); + + if I.Node = J.Node then + return; + end if; - begin - I.Node.Element := J.Node.Element; - J.Node.Element := EI; + pragma Assert (C.Length > 1); + pragma Assert (J.Node /= null); + pragma Assert (J.Node.Element /= null); + pragma Assert (J.Node.Prev = null + or else J.Node.Prev.Next = J.Node); + pragma Assert (J.Node.Next = null + or else J.Node.Next.Prev = J.Node); + pragma Assert (J.Node.Prev /= null + or else J.Node = C.First); + pragma Assert (J.Node.Next /= null + or else J.Node = C.Last); + + if C.Lock > 0 then + raise Program_Error; + end if; + + declare + EI_Copy : constant Element_Access := I.Node.Element; + begin + I.Node.Element := J.Node.Element; + J.Node.Element := EI_Copy; + end; + end; end Swap; ---------------- @@ -1233,8 +1793,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is I, J : Cursor) is begin - if I = No_Element - or else J = No_Element + if I.Container = null + or else J.Container = null then raise Constraint_Error; end if; @@ -1248,12 +1808,39 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; pragma Assert (Container.Length >= 1); + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); + + pragma Assert (I.Node /= null); + pragma Assert (I.Node.Element /= null); + pragma Assert (I.Node.Prev = null + or else I.Node.Prev.Next = I.Node); + pragma Assert (I.Node.Next = null + or else I.Node.Next.Prev = I.Node); + pragma Assert (I.Node.Prev /= null + or else I.Node = Container.First); + pragma Assert (I.Node.Next /= null + or else I.Node = Container.Last); if I.Node = J.Node then return; end if; pragma Assert (Container.Length >= 2); + pragma Assert (J.Node /= null); + pragma Assert (J.Node.Element /= null); + pragma Assert (J.Node.Prev = null + or else J.Node.Prev.Next = J.Node); + pragma Assert (J.Node.Next = null + or else J.Node.Next.Prev = J.Node); + pragma Assert (J.Node.Prev /= null + or else J.Node = Container.First); + pragma Assert (J.Node.Next /= null + or else J.Node = Container.Last); + + if Container.Busy > 0 then + raise Program_Error; + end if; declare I_Next : constant Cursor := Next (I); @@ -1278,6 +1865,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end; end if; end; + + pragma Assert (Container.First.Prev = null); + pragma Assert (Container.Last.Next = null); end Swap_Links; -------------------- @@ -1288,8 +1878,43 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Position : Cursor; Process : not null access procedure (Element : in out Element_Type)) is + pragma Assert (Position.Container /= null); + pragma Assert (Position.Container.Length > 0); + pragma Assert (Position.Container.First.Prev = null); + pragma Assert (Position.Container.Last.Next = null); + + pragma Assert (Position.Node /= null); + pragma Assert (Position.Node.Element /= null); + pragma Assert (Position.Node.Prev = null + or else Position.Node.Prev.Next = Position.Node); + pragma Assert (Position.Node.Next = null + or else Position.Node.Next.Prev = Position.Node); + pragma Assert (Position.Node.Prev /= null + or else Position.Node = Position.Container.First); + pragma Assert (Position.Node.Next /= null + or else Position.Node = Position.Container.Last); + + E : Element_Type renames Position.Node.Element.all; + + C : List renames Position.Container.all'Unrestricted_Access.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin - Process (Position.Node.Element.all); + B := B + 1; + L := L + 1; + + begin + Process (E); + exception + when others => + L := L - 1; + B := B - 1; + raise; + end; + + L := L - 1; + B := B - 1; end Update_Element; ----------- @@ -1310,5 +1935,3 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end Write; end Ada.Containers.Indefinite_Doubly_Linked_Lists; - - |