diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/a-cdlili.adb | 82 | ||||
| -rw-r--r-- | gcc/ada/a-cdlili.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-cidlli.adb | 83 | ||||
| -rw-r--r-- | gcc/ada/a-cidlli.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/a-cihama.adb | 46 | ||||
| -rw-r--r-- | gcc/ada/a-ciorma.adb | 169 | ||||
| -rw-r--r-- | gcc/ada/a-ciorma.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/a-cohama.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/a-cohama.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/a-convec.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/a-coorma.adb | 125 | ||||
| -rw-r--r-- | gcc/ada/a-coorma.ads | 8 |
13 files changed, 351 insertions, 233 deletions
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb index 958a105a734..c6d7dbff0fe 100644 --- a/gcc/ada/a-cdlili.adb +++ b/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; - 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; diff --git a/gcc/ada/a-cdlili.ads b/gcc/ada/a-cdlili.ads index 3682104cba9..41f8606079b 100644 --- a/gcc/ada/a-cdlili.ads +++ b/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; - Before : Cursor; - Position : Cursor); + (Container : in out List; + Before : Cursor; + Position : in out Cursor); function First (Container : List) return Cursor; diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index 46d94449b03..0752f9fa09c 100644 --- a/gcc/ada/a-cidlli.adb +++ b/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; - 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; diff --git a/gcc/ada/a-cidlli.ads b/gcc/ada/a-cidlli.ads index 9e2d2351268..e6fbf7694cf 100644 --- a/gcc/ada/a-cidlli.ads +++ b/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; - Before : Cursor; - Position : Cursor); + (Container : in out List; + Before : Cursor; + Position : in out Cursor); function First (Container : List) return Cursor; diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index 3836f7eb035..3a78e8eab0d 100644 --- a/gcc/ada/a-cihama.adb +++ b/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; diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index 256304281a8..fda5c3971de 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -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; diff --git a/gcc/ada/a-ciorma.ads b/gcc/ada/a-ciorma.ads index 8837e048e00..7d16b2b4c1a 100644 --- a/gcc/ada/a-ciorma.ads +++ b/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; diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb index d235d0b0c79..a29784bdb45 100644 --- a/gcc/ada/a-cohama.adb +++ b/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; diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads index 42b1cada502..d65401f01eb 100644 --- a/gcc/ada/a-cohama.ads +++ b/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; diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index b3c7cd8e910..6aee444e1b0 100644 --- a/gcc/ada/a-coinve.adb +++ b/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); diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index b298fd6a736..2a603034749 100644 --- a/gcc/ada/a-convec.adb +++ b/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; ---------------- diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb index fad63d4e498..95b8796c8d4 100644 --- a/gcc/ada/a-coorma.adb +++ b/gcc/ada/a-coorma.adb @@ -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; diff --git a/gcc/ada/a-coorma.ads b/gcc/ada/a-coorma.ads index 7f8386b4b13..f07b07373d0 100644 --- a/gcc/ada/a-coorma.ads +++ b/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; |