X-Git-Url: http://review.tizen.org/git/?a=blobdiff_plain;f=gcc%2Fada%2Fa-ciorse.adb;h=a6538665a1bc90583bc4bcc8fffa28e5d21c6da5;hb=4d8cd3a26294ce35abb17668eac2b6c38dd23bd0;hp=7b919494a171393fe5e9b28edf8f1307598a4aee;hpb=c944d49b3bd3667c65c299afd3b1d756084203f4;p=platform%2Fupstream%2Fgcc48.git diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb index 7b91949..a653866 100644 --- a/gcc/ada/a-ciorse.adb +++ b/gcc/ada/a-ciorse.adb @@ -359,7 +359,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Ceiling (Container : Set; Item : Element_Type) return Cursor is Node : constant Node_Access := - Element_Keys.Ceiling (Container.Tree, Item); + Element_Keys.Ceiling (Container.Tree, Item); begin return (if Node = null then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -418,9 +418,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is L : Natural renames Tree.Lock; begin return R : constant Constant_Reference_Type := - (Element => Position.Node.Element.all'Access, - Control => - (Controlled with Container'Unrestricted_Access)) + (Element => Position.Node.Element.all'Access, + Control => (Controlled with Container'Unrestricted_Access)) do B := B + 1; L := L + 1; @@ -494,8 +493,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end Delete; procedure Delete (Container : in out Set; Item : Element_Type) is - X : Node_Access := - Element_Keys.Find (Container.Tree, Item); + X : Node_Access := Element_Keys.Find (Container.Tree, Item); begin if X = null then @@ -620,8 +618,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ------------- procedure Exclude (Container : in out Set; Item : Element_Type) is - X : Node_Access := - Element_Keys.Find (Container.Tree, Item); + X : Node_Access := Element_Keys.Find (Container.Tree, Item); begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); @@ -665,8 +662,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ---------- function Find (Container : Set; Item : Element_Type) return Cursor is - Node : constant Node_Access := - Element_Keys.Find (Container.Tree, Item); + Node : constant Node_Access := Element_Keys.Find (Container.Tree, Item); begin if Node = null then return No_Element; @@ -726,8 +722,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ----------- function Floor (Container : Set; Item : Element_Type) return Cursor is - Node : constant Node_Access := - Element_Keys.Floor (Container.Tree, Item); + Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item); begin return (if Node = null then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -798,8 +793,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ------------- function Ceiling (Container : Set; Key : Key_Type) return Cursor is - Node : constant Node_Access := - Key_Keys.Ceiling (Container.Tree, Key); + Node : constant Node_Access := Key_Keys.Ceiling (Container.Tree, Key); begin return (if Node = null then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -813,8 +807,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is (Container : aliased Set; Key : Key_Type) return Constant_Reference_Type is - Node : constant Node_Access := - Key_Keys.Find (Container.Tree, Key); + Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key); begin if Node = null then @@ -831,9 +824,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is L : Natural renames Tree.Lock; begin return R : constant Constant_Reference_Type := - (Element => Node.Element.all'Access, - Control => - (Controlled with Container'Unrestricted_Access)) + (Element => Node.Element.all'Access, + Control => (Controlled with Container'Unrestricted_Access)) do B := B + 1; L := L + 1; @@ -871,8 +863,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ------------- function Element (Container : Set; Key : Key_Type) return Element_Type is - Node : constant Node_Access := - Key_Keys.Find (Container.Tree, Key); + Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key); begin if Node = null then raise Constraint_Error with "key not in set"; @@ -912,8 +903,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ---------- function Find (Container : Set; Key : Key_Type) return Cursor is - Node : constant Node_Access := - Key_Keys.Find (Container.Tree, Key); + Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key); begin return (if Node = null then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -924,8 +914,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ----------- function Floor (Container : Set; Key : Key_Type) return Cursor is - Node : constant Node_Access := - Key_Keys.Floor (Container.Tree, Key); + Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key); begin return (if Node = null then No_Element else Cursor'(Container'Unrestricted_Access, Node)); @@ -1046,8 +1035,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is (Container : aliased in out Set; Key : Key_Type) return Reference_Type is - Node : constant Node_Access := - Key_Keys.Find (Container.Tree, Key); + Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key); begin if Node = null then @@ -1173,9 +1161,18 @@ package body Ada.Containers.Indefinite_Ordered_Sets is "attempt to tamper with elements (set is locked)"; end if; - X := Position.Node.Element; - Position.Node.Element := new Element_Type'(New_Item); - Free_Element (X); + declare + -- The element allocator may need an accessibility check in the + -- case the actual type is class-wide or has access discriminants + -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + + begin + X := Position.Node.Element; + Position.Node.Element := new Element_Type'(New_Item); + Free_Element (X); + end; end if; end Include; @@ -1238,6 +1235,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -------------- function New_Node return Node_Access is + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + Element : Element_Access := new Element_Type'(New_Item); begin @@ -1246,6 +1249,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is Right => null, Color => Red_Black_Trees.Red, Element => Element); + exception when others => Free_Element (Element); @@ -1293,8 +1297,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -------------- function New_Node return Node_Access is - Element : Element_Access := - new Element_Type'(Src_Node.Element.all); + Element : Element_Access := new Element_Type'(Src_Node.Element.all); Node : Node_Access; begin @@ -1332,7 +1335,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Intersection (Left, Right : Set) return Set is Tree : constant Tree_Type := - Set_Ops.Intersection (Left.Tree, Right.Tree); + Set_Ops.Intersection (Left.Tree, Right.Tree); begin return Set'(Controlled with Tree); end Intersection; @@ -1450,9 +1453,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -- for a reverse iterator, Container.Last is the beginning. return It : constant Iterator := - Iterator'(Limited_Controlled with - Container => Container'Unrestricted_Access, - Node => null) + Iterator'(Limited_Controlled with + Container => Container'Unrestricted_Access, + Node => null) do B := B + 1; end return; @@ -1500,9 +1503,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -- a forward or reverse iteration. return It : constant Iterator := - (Limited_Controlled with - Container => Container'Unrestricted_Access, - Node => Start.Node) + (Limited_Controlled with + Container => Container'Unrestricted_Access, + Node => Start.Node) do B := B + 1; end return; @@ -1606,8 +1609,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is "bad cursor in Next"); declare - Node : constant Node_Access := - Tree_Operations.Next (Position.Node); + Node : constant Node_Access := Tree_Operations.Next (Position.Node); begin return (if Node = null then No_Element else Cursor'(Position.Container, Node)); @@ -1673,7 +1675,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is declare Node : constant Node_Access := - Tree_Operations.Previous (Position.Node); + Tree_Operations.Previous (Position.Node); begin return (if Node = null then No_Element else Cursor'(Position.Container, Node)); @@ -1803,7 +1805,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is procedure Replace (Container : in out Set; New_Item : Element_Type) is Node : constant Node_Access := - Element_Keys.Find (Container.Tree, New_Item); + Element_Keys.Find (Container.Tree, New_Item); X : Element_Access; pragma Warnings (Off, X); @@ -1818,9 +1820,18 @@ package body Ada.Containers.Indefinite_Ordered_Sets is "attempt to tamper with elements (set is locked)"; end if; - X := Node.Element; - Node.Element := new Element_Type'(New_Item); - Free_Element (X); + declare + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + + begin + X := Node.Element; + Node.Element := new Element_Type'(New_Item); + Free_Element (X); + end; end Replace; --------------------- @@ -1854,6 +1865,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -------------- function New_Node return Node_Access is + + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); -- OK if fails Node.Color := Red; @@ -1872,9 +1890,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -- Start of processing for Replace_Element begin - if Item < Node.Element.all - or else Node.Element.all < Item - then + if Item < Node.Element.all or else Node.Element.all < Item then null; else @@ -1883,8 +1899,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is "attempt to tamper with elements (set is locked)"; end if; - Node.Element := new Element_Type'(Item); - Free_Element (X); + declare + -- The element allocator may need an accessibility check in the + -- case the actual type is class-wide or has access discriminants + -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + + begin + Node.Element := new Element_Type'(Item); + Free_Element (X); + end; return; end if; @@ -1901,8 +1926,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is "attempt to tamper with elements (set is locked)"; end if; - Node.Element := new Element_Type'(Item); - Free_Element (X); + declare + -- The element allocator may need an accessibility check in the + -- case actual type is class-wide or has access discriminants + -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + + begin + Node.Element := new Element_Type'(Item); + Free_Element (X); + end; return; end if; @@ -2049,7 +2083,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Symmetric_Difference (Left, Right : Set) return Set is Tree : constant Tree_Type := - Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree); + Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree); begin return Set'(Controlled with Tree); end Symmetric_Difference; @@ -2078,8 +2112,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end Union; function Union (Left, Right : Set) return Set is - Tree : constant Tree_Type := - Set_Ops.Union (Left.Tree, Right.Tree); + Tree : constant Tree_Type := Set_Ops.Union (Left.Tree, Right.Tree); begin return Set'(Controlled with Tree); end Union;