diff options
Diffstat (limited to 'gcc/ada/a-cidlli.adb')
| -rw-r--r-- | gcc/ada/a-cidlli.adb | 273 |
1 files changed, 151 insertions, 122 deletions
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index f34c9e5..cf9cdcf 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -9,10 +9,6 @@ -- -- -- Copyright (C) 2004-2006, 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 -- --- apply solely to the contents of the part following the private keyword. -- --- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- @@ -180,7 +176,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Container.Last.Next = null); if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; while Container.Length > 1 loop @@ -230,15 +227,18 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin if Position.Node = null then - raise Constraint_Error; + raise Constraint_Error with + "Position cursor has no element"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Position cursor has no element"; end if; if Position.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; pragma Assert (Vet (Position), "bad cursor in Delete"); @@ -255,7 +255,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; for Index in 1 .. Count loop @@ -304,7 +305,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; for I in 1 .. Count loop @@ -341,7 +343,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; for I in 1 .. Count loop @@ -364,11 +367,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Element (Position : Cursor) return Element_Type is begin if Position.Node = null then - raise Constraint_Error; + raise Constraint_Error with + "Position cursor has no element"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Position cursor has no element"; end if; pragma Assert (Vet (Position), "bad cursor in Element"); @@ -397,7 +402,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Position.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; pragma Assert (Vet (Position), "bad cursor in Find"); @@ -434,7 +440,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function First_Element (Container : List) return Element_Type is begin if Container.First = null then - raise Constraint_Error; + raise Constraint_Error with "list is empty"; end if; return Container.First.Element.all; @@ -497,18 +503,21 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Target : in out List; Source : in out List) is - LI : Cursor; - RI : Cursor; + LI, RI : Cursor; begin if Target'Address = Source'Address then return; end if; - if Target.Busy > 0 - or else Source.Busy > 0 - then - raise Program_Error; + if Target.Busy > 0 then + raise Program_Error with + "attempt to tamper with elements of Target (list is busy)"; + end if; + + if Source.Busy > 0 then + raise Program_Error with + "attempt to tamper with elements of Source (list is busy)"; end if; LI := First (Target); @@ -624,7 +633,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Container.Last.Next = null); if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; Sort (Front => null, Back => null); @@ -661,13 +671,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin if Before.Container /= null then if Before.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; if Before.Node = null or else Before.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Before cursor has no element"; end if; pragma Assert (Vet (Before), "bad cursor in Insert"); @@ -679,11 +691,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Container.Length > Count_Type'Last - Count then - raise Constraint_Error; + raise Constraint_Error with "new length exceeds maximum"; end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; declare @@ -833,7 +846,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Last_Element (Container : List) return Element_Type is begin if Container.Last = null then - raise Constraint_Error; + raise Constraint_Error with "list is empty"; end if; return Container.Last.Element.all; @@ -859,7 +872,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Source.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements of Source (list is busy)"; end if; Clear (Target); @@ -880,27 +894,17 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Next (Position : in out Cursor) is begin - pragma Assert (Vet (Position), "bad cursor in procedure Next"); - - if Position.Node = null then - return; - end if; - - Position.Node := Position.Node.Next; - - if Position.Node = null then - Position.Container := null; - end if; + Position := Next (Position); end Next; function Next (Position : Cursor) return Cursor is begin - pragma Assert (Vet (Position), "bad cursor in function Next"); - if Position.Node = null then return No_Element; end if; + pragma Assert (Vet (Position), "bad cursor in Next"); + declare Next_Node : constant Node_Access := Position.Node.Next; begin @@ -931,27 +935,17 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Previous (Position : in out Cursor) is begin - pragma Assert (Vet (Position), "bad cursor in procedure Previous"); - - if Position.Node = null then - return; - end if; - - Position.Node := Position.Node.Prev; - - if Position.Node = null then - Position.Container := null; - end if; + Position := Previous (Position); end Previous; function Previous (Position : Cursor) return Cursor is begin - pragma Assert (Vet (Position), "bad cursor in function Previous"); - if Position.Node = null then return No_Element; end if; + pragma Assert (Vet (Position), "bad cursor in Previous"); + declare Prev_Node : constant Node_Access := Position.Node.Prev; begin @@ -973,11 +967,13 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is is begin if Position.Node = null then - raise Constraint_Error; + raise Constraint_Error with + "Position cursor has no element"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Position cursor has no element"; end if; pragma Assert (Vet (Position), "bad cursor in Query_Element"); @@ -1010,7 +1006,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ---------- procedure Read - (Stream : access Root_Stream_Type'Class; + (Stream : not null access Root_Stream_Type'Class; Item : out List) is N : Count_Type'Base; @@ -1059,11 +1055,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists 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 list cursor"; end Read; --------------------- @@ -1077,19 +1073,22 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is is begin if Position.Container = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; if Position.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; - if Position.Container.Lock > 0 then - raise Program_Error; + if Container.Lock > 0 then + raise Program_Error with + "attempt to tamper with cursors (list is locked)"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Position cursor has no element"; end if; pragma Assert (Vet (Position), "bad cursor in Replace_Element"); @@ -1162,7 +1161,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Container.Last.Next = null); if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; Container.First := J; @@ -1206,11 +1206,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is else if Node.Element = null then - raise Program_Error; + raise Program_Error with "Position cursor has no element"; end if; if Position.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; pragma Assert (Vet (Position), "bad cursor in Reverse_Find"); @@ -1269,13 +1270,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin if Before.Container /= null then if Before.Container /= Target'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Before cursor designates wrong container"; end if; if Before.Node = null or else Before.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Before cursor has no element"; end if; pragma Assert (Vet (Before), "bad cursor in Splice"); @@ -1291,13 +1294,17 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Source.Last.Next = null); if Target.Length > Count_Type'Last - Source.Length then - raise Constraint_Error; + raise Constraint_Error with "new length exceeds maximum"; end if; - if Target.Busy > 0 - or else Source.Busy > 0 - then - raise Program_Error; + if Target.Busy > 0 then + raise Program_Error with + "attempt to tamper with elements of Target (list is busy)"; + end if; + + if Source.Busy > 0 then + raise Program_Error with + "attempt to tamper with elements of Source (list is busy)"; end if; if Target.Length = 0 then @@ -1343,33 +1350,36 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Splice (Container : in out List; Before : Cursor; - Position : in out Cursor) + Position : Cursor) is begin if Before.Container /= null then if Before.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with + "Before cursor designates wrong container"; end if; if Before.Node = null or else Before.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Before cursor has no element"; end if; pragma Assert (Vet (Before), "bad Before cursor in Splice"); end if; if Position.Node = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with "Position cursor has no element"; end if; if Position.Container /= Container'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; pragma Assert (Vet (Position), "bad Position cursor in Splice"); @@ -1383,7 +1393,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Container.Length >= 2); if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; if Before.Node = null then @@ -1463,40 +1474,48 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is if Before.Container /= null then if Before.Container /= Target'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Before cursor designates wrong container"; end if; if Before.Node = null or else Before.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Before cursor has no element"; end if; pragma Assert (Vet (Before), "bad Before cursor in Splice"); end if; if Position.Node = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Position cursor has no element"; end if; if Position.Container /= Source'Unrestricted_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; pragma Assert (Vet (Position), "bad Position cursor in Splice"); if Target.Length = Count_Type'Last then - raise Constraint_Error; + raise Constraint_Error with "Target is full"; end if; - if Target.Busy > 0 - or else Source.Busy > 0 - then - raise Program_Error; + if Target.Busy > 0 then + raise Program_Error with + "attempt to tamper with elements of Target (list is busy)"; + end if; + + if Source.Busy > 0 then + raise Program_Error with + "attempt to tamper with elements of Source (list is busy)"; end if; if Position.Node = Source.First then @@ -1573,16 +1592,20 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is I, J : Cursor) is begin - if I.Node = null - or else J.Node = null - then - raise Constraint_Error; + if I.Node = null then + raise Constraint_Error with "I cursor has no element"; end if; - if I.Container /= Container'Unchecked_Access - or else J.Container /= Container'Unchecked_Access - then - raise Program_Error; + if J.Node = null then + raise Constraint_Error with "J cursor has no element"; + end if; + + if I.Container /= Container'Unchecked_Access then + raise Program_Error with "I cursor designates wrong container"; + end if; + + if J.Container /= Container'Unchecked_Access then + raise Program_Error with "J cursor designates wrong container"; end if; if I.Node = J.Node then @@ -1590,7 +1613,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Container.Lock > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with cursors (list is locked)"; end if; pragma Assert (Vet (I), "bad I cursor in Swap"); @@ -1614,16 +1638,20 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is I, J : Cursor) is begin - if I.Node = null - or else J.Node = null - then - raise Constraint_Error; + if I.Node = null then + raise Constraint_Error with "I cursor has no element"; end if; - if I.Container /= Container'Unrestricted_Access - or else I.Container /= J.Container - then - raise Program_Error; + if J.Node = null then + raise Constraint_Error with "J cursor has no element"; + end if; + + if I.Container /= Container'Unrestricted_Access then + raise Program_Error with "I cursor designates wrong container"; + end if; + + if J.Container /= Container'Unrestricted_Access then + raise Program_Error with "J cursor designates wrong container"; end if; if I.Node = J.Node then @@ -1631,7 +1659,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; if Container.Busy > 0 then - raise Program_Error; + raise Program_Error with + "attempt to tamper with elements (list is busy)"; end if; pragma Assert (Vet (I), "bad I cursor in Swap_Links"); @@ -1639,26 +1668,24 @@ 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_Copy); + Splice (Container, Before => I, Position => J); else declare J_Next : constant Cursor := Next (J); - I_Copy : Cursor := I; begin if J_Next = I then - Splice (Container, Before => J, Position => I_Copy); + Splice (Container, Before => J, Position => I); else pragma Assert (Container.Length >= 3); - Splice (Container, Before => I_Next, Position => J_Copy); - Splice (Container, Before => J_Next, Position => I_Copy); + Splice (Container, Before => I_Next, Position => J); + Splice (Container, Before => J_Next, Position => I); end if; end; end if; @@ -1679,15 +1706,17 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is is begin if Position.Node = null then - raise Constraint_Error; + raise Constraint_Error with "Position cursor has no element"; end if; if Position.Node.Element = null then - raise Program_Error; + raise Program_Error with + "Position cursor has no element"; end if; if Position.Container /= Container'Unchecked_Access then - raise Program_Error; + raise Program_Error with + "Position cursor designates wrong container"; end if; pragma Assert (Vet (Position), "bad cursor in Update_Element"); @@ -1862,7 +1891,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ----------- procedure Write - (Stream : access Root_Stream_Type'Class; + (Stream : not null access Root_Stream_Type'Class; Item : List) is Node : Node_Access := Item.First; @@ -1871,17 +1900,17 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Count_Type'Base'Write (Stream, Item.Length); while Node /= null loop - Element_Type'Output (Stream, Node.Element.all); -- X.all + Element_Type'Output (Stream, Node.Element.all); Node := Node.Next; end loop; 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 list cursor"; end Write; end Ada.Containers.Indefinite_Doubly_Linked_Lists; |