From ce72a9a305f5de10f43446aaf3c3fecdf77d7987 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 6 Oct 2011 21:24:49 +0200 Subject: [PATCH] [multiple changes] 2011-10-06 Robert Dewar * a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb, a-cborse.adb, a-comutr.adb, a-ciorma.adb, a-cbmutr.adb, a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads: Minor reformatting and code reorganization (use conditional expressions). 2011-10-06 Robert Dewar * sem_res.adb (Resolve_Arithmetic_Op): Fix bad warning for floating divide by zero. 2011-10-06 Ed Schonberg * sem_ch6.adb: Limited interfaces that are not immutably limited are OK in return statements. From-SVN: r179629 --- gcc/ada/ChangeLog | 17 +++++ gcc/ada/a-cbhase.adb | 94 ++++++++++---------------- gcc/ada/a-cbhase.ads | 17 ++--- gcc/ada/a-cbmutr.adb | 36 +++++----- gcc/ada/a-cbmutr.ads | 2 +- gcc/ada/a-cborse.adb | 137 ++++++++++---------------------------- gcc/ada/a-cihase.adb | 95 ++++++++++----------------- gcc/ada/a-cihase.ads | 7 +- gcc/ada/a-ciorma.adb | 132 +++++++++++-------------------------- gcc/ada/a-ciorse.adb | 129 ++++++++++++------------------------ gcc/ada/a-comutr.adb | 65 +++++++----------- gcc/ada/a-coorse.adb | 153 ++++++++++++------------------------------- gcc/ada/sem_ch6.adb | 13 +++- gcc/ada/sem_res.adb | 29 ++++++-- 14 files changed, 322 insertions(+), 604 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a7be9a2af55..1a1bb68d318 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2011-10-06 Robert Dewar + + * a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb, + a-cborse.adb, a-comutr.adb, a-ciorma.adb, a-cbmutr.adb, + a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads: Minor reformatting and code + reorganization (use conditional expressions). + +2011-10-06 Robert Dewar + + * sem_res.adb (Resolve_Arithmetic_Op): Fix bad warning for + floating divide by zero. + +2011-10-06 Ed Schonberg + + * sem_ch6.adb: Limited interfaces that are not immutably limited + are OK in return statements. + 2011-09-30 Iain Sandoe * gcc-interface/Makefile.in (Darwin): Partial reversion of previous diff --git a/gcc/ada/a-cbhase.adb b/gcc/ada/a-cbhase.adb index 7dcd074995d..97a765a6839 100644 --- a/gcc/ada/a-cbhase.adb +++ b/gcc/ada/a-cbhase.adb @@ -47,7 +47,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is overriding function First (Object : Iterator) return Cursor; overriding function Next - (Object : Iterator; + (Object : Iterator; Position : Cursor) return Cursor; ----------------------- @@ -68,9 +68,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is Node : out Count_Type; Inserted : out Boolean); - function Is_In - (HT : Set; - Key : Node_Type) return Boolean; + function Is_In (HT : Set; Key : Node_Type) return Boolean; pragma Inline (Is_In); procedure Set_Element (Node : in out Node_Type; Item : Element_Type); @@ -169,7 +167,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is N : Node_Type renames Source.Nodes (Source_Node); X : Count_Type; B : Boolean; - begin Insert (Target, N.Element, X, B); pragma Assert (B); @@ -233,10 +230,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is begin if Capacity = 0 then C := Source.Length; - elsif Capacity >= Source.Length then C := Capacity; - else raise Capacity_Error with "Capacity value too small"; end if; @@ -396,7 +391,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is N : Node_Type renames Left.Nodes (L_Node); X : Count_Type; B : Boolean; - begin if not Is_In (Right, N) then Insert (Result, N.Element, X, B); -- optimize this ??? @@ -428,7 +422,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is declare S : Set renames Position.Container.all; N : Node_Type renames S.Nodes (Position.Node); - begin return N.Element; end; @@ -488,6 +481,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is function Equivalent_Elements (Left, Right : Cursor) return Boolean is + begin if Left.Node = 0 then raise Constraint_Error with @@ -505,14 +499,15 @@ package body Ada.Containers.Bounded_Hashed_Sets is declare LN : Node_Type renames Left.Container.Nodes (Left.Node); RN : Node_Type renames Right.Container.Nodes (Right.Node); - begin return Equivalent_Elements (LN.Element, RN.Element); end; end Equivalent_Elements; - function Equivalent_Elements (Left : Cursor; Right : Element_Type) - return Boolean is + function Equivalent_Elements + (Left : Cursor; + Right : Element_Type) return Boolean + is begin if Left.Node = 0 then raise Constraint_Error with @@ -528,8 +523,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is end; end Equivalent_Elements; - function Equivalent_Elements (Left : Element_Type; Right : Cursor) - return Boolean is + function Equivalent_Elements + (Left : Element_Type; + Right : Cursor) return Boolean + is begin if Right.Node = 0 then raise Constraint_Error with @@ -551,8 +548,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is -- Equivalent_Keys -- --------------------- - function Equivalent_Keys (Key : Element_Type; Node : Node_Type) - return Boolean is + function Equivalent_Keys + (Key : Element_Type; + Node : Node_Type) return Boolean + is begin return Equivalent_Elements (Key, Node.Element); end Equivalent_Keys; @@ -580,13 +579,9 @@ package body Ada.Containers.Bounded_Hashed_Sets is Item : Element_Type) return Cursor is Node : constant Count_Type := Element_Keys.Find (Container, Item); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -595,23 +590,16 @@ package body Ada.Containers.Bounded_Hashed_Sets is function First (Container : Set) return Cursor is Node : constant Count_Type := HT_Ops.First (Container); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end First; overriding function First (Object : Iterator) return Cursor is Node : constant Count_Type := HT_Ops.First (Object.Container.all); begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Object.Container, Node); + return (if Node = 0 then No_Element + else Cursor'(Object.Container, Node)); end First; ----------------- @@ -999,11 +987,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is "Position cursor designates wrong set"; end if; - if Position.Node = 0 then - return No_Element; - end if; - - return Next (Position); + return (if Position.Node = 0 then No_Element else Next (Position)); end Next; ------------- @@ -1143,12 +1127,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Container : aliased Set; Position : Cursor) return Constant_Reference_Type is + pragma Unreferenced (Container); S : Set renames Position.Container.all; N : Node_Type renames S.Nodes (Position.Node); - begin - pragma Unreferenced (Container); - return (Element => N.Element'Unrestricted_Access); end Constant_Reference; @@ -1316,7 +1298,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is N : Node_Type renames Left.Nodes (L_Node); X : Count_Type; B : Boolean; - begin if not Is_In (Right, N) then Insert (Result, N.Element, X, B); @@ -1344,7 +1325,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is N : Node_Type renames Right.Nodes (R_Node); X : Count_Type; B : Boolean; - begin if not Is_In (Left, N) then Insert (Result, N.Element, X, B); @@ -1367,7 +1347,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is function To_Set (New_Item : Element_Type) return Set is X : Count_Type; B : Boolean; - begin return Result : Set (1, 1) do Insert (Result, New_Item, X, B); @@ -1396,7 +1375,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is N : Node_Type renames Source.Nodes (Src_Node); X : Count_Type; B : Boolean; - begin Insert (Target, N.Element, X, B); end Process; @@ -1413,7 +1391,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is "attempt to tamper with cursors (set is busy)"; end if; - -- ??? + -- ??? why is this code commented out ??? -- declare -- N : constant Count_Type := Target.Length + Source.Length; -- begin @@ -1661,15 +1639,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Container : Set; Key : Key_Type) return Cursor is - Node : constant Count_Type := - Key_Keys.Find (Container, Key); - + Node : constant Count_Type := Key_Keys.Find (Container, Key); begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; --------- @@ -1684,7 +1657,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is end if; pragma Assert (Vet (Position), "bad cursor in function Key"); - return Key (Position.Container.Nodes (Position.Node).Element); end Key; @@ -1697,8 +1669,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is Key : Key_Type; New_Item : Element_Type) is - Node : constant Count_Type := - Key_Keys.Find (Container, Key); + Node : constant Count_Type := Key_Keys.Find (Container, Key); begin if Node = 0 then @@ -1733,7 +1704,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is "Position cursor designates wrong set"; end if; - -- ??? + -- ??? why is this code commented out ??? -- if HT.Buckets = null -- or else HT.Buckets'Length = 0 -- or else HT.Length = 0 @@ -1747,7 +1718,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is (Vet (Position), "bad cursor in Update_Element_Preserving_Key"); - -- Record bucket now, in case key is changed. + -- Record bucket now, in case key is changed + Indx := HT_Ops.Index (Container.Buckets, N (Position.Node)); declare @@ -1823,10 +1795,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is function Reference_Preserving_Key (Container : aliased in out Set; - Key : Key_Type) return Reference_Type + Key : Key_Type) return Reference_Type is Position : constant Cursor := Find (Container, Key); - N : Node_Type renames Container.Nodes (Position.Node); + N : Node_Type renames Container.Nodes (Position.Node); begin return (Element => N.Element'Unrestricted_Access); end Reference_Preserving_Key; diff --git a/gcc/ada/a-cbhase.ads b/gcc/ada/a-cbhase.ads index c72b8ab8597..3f6b6696871 100644 --- a/gcc/ada/a-cbhase.ads +++ b/gcc/ada/a-cbhase.ads @@ -148,8 +148,7 @@ package Ada.Containers.Bounded_Hashed_Sets is function Constant_Reference (Container : aliased Set; - Position : Cursor) - return Constant_Reference_Type; + Position : Cursor) return Constant_Reference_Type; procedure Assign (Target : in out Set; Source : Set); -- If Target denotes the same object as Source, then the operation has no @@ -355,8 +354,9 @@ package Ada.Containers.Bounded_Hashed_Sets is Process : not null access procedure (Position : Cursor)); -- Calls Process for each node in the set - function Iterate (Container : Set) - return Set_Iterator_Interfaces.Forward_Iterator'Class; + function Iterate + (Container : Set) + return Set_Iterator_Interfaces.Forward_Iterator'Class; generic type Key_Type (<>) is private; @@ -431,13 +431,11 @@ package Ada.Containers.Bounded_Hashed_Sets is function Reference_Preserving_Key (Container : aliased in out Set; - Position : Cursor) - return Reference_Type; + Position : Cursor) return Reference_Type; function Reference_Preserving_Key (Container : aliased in out Set; - Key : Key_Type) - return Reference_Type; + Key : Key_Type) return Reference_Type; private type Reference_Type (Element : not null access Element_Type) @@ -446,7 +444,6 @@ package Ada.Containers.Bounded_Hashed_Sets is end Generic_Keys; private - pragma Inline (Next); type Node_Type is record @@ -519,6 +516,6 @@ private for Constant_Reference_Type'Write use Write; Empty_Set : constant Set := - (Hash_Table_Type with Capacity => 0, Modulus => 0); + (Hash_Table_Type with Capacity => 0, Modulus => 0); end Ada.Containers.Bounded_Hashed_Sets; diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb index f4bdc5e4035..7ad2de4e62a 100644 --- a/gcc/ada/a-cbmutr.adb +++ b/gcc/ada/a-cbmutr.adb @@ -54,11 +54,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is overriding function First (Object : Child_Iterator) return Cursor; overriding function Next - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor; overriding function Previous - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor; overriding function Last (Object : Child_Iterator) return Cursor; @@ -599,10 +599,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is begin if Capacity = 0 then C := Source.Count; - elsif Capacity >= Source.Count then C := Capacity; - else raise Capacity_Error with "Capacity value too small"; end if; @@ -841,12 +839,12 @@ package body Ada.Containers.Bounded_Multiway_Trees is -- nodes that contain elements that have been inserted onto the tree, -- and another for the "inactive" nodes of the free store, from which -- nodes are allocated when a new child is inserted in the tree. - -- + -- We desire that merely declaring a tree object should have only -- minimal cost; specially, we want to avoid having to initialize the -- free store (to fill in the links), especially if the capacity of the -- tree object is large. - -- + -- The head of the free list is indicated by Container.Free. If its -- value is non-negative, then the free store has been initialized in -- the "normal" way: Container.Free points to the head of the list of @@ -854,20 +852,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is -- empty. Each node on the free list has been initialized to point to -- the next free node (via its Next component), and the value 0 means -- that this is the last node of the free list. - -- + -- If Container.Free is negative, then the links on the free store have -- not been initialized. In this case the link values are implied: the -- free store comprises the components of the node array started with -- the absolute value of Container.Free, and continuing until the end of -- the array (Nodes'Last). - -- + -- We prefer to lazy-init the free store (in fact, we would prefer to -- not initialize it at all, because such initialization is an O(n) -- operation). The time when we need to actually initialize the nodes in -- the free store is when the node that becomes inactive is not at the -- end of the active list. The free store would then be discontigous and -- so its nodes would need to be linked in the traditional way. - -- + -- It might be possible to perform an optimization here. Suppose that -- the free store can be represented as having two parts: one comprising -- the non-contiguous inactive nodes linked together in the normal way, @@ -1218,8 +1216,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is Right_Subtree : Count_Type) return Boolean is begin - if Left_Tree.Elements (Left_Subtree) - /= Right_Tree.Elements (Right_Subtree) + if Left_Tree.Elements (Left_Subtree) /= + Right_Tree.Elements (Right_Subtree) then return False; end if; @@ -1262,7 +1260,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is function First (Object : Child_Iterator) return Cursor is Node : Count_Type'Base; - begin Node := Object.Container.Nodes (Object.Position.Node).Children.First; return (Object.Container, Node); @@ -1722,11 +1719,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is function Is_Root (Position : Cursor) return Boolean is begin - if Position.Container = null then - return False; - end if; - - return Position.Node = Root_Node (Position.Container.all); + return + (if Position.Container = null then False + else Position.Node = Root_Node (Position.Container.all)); end Is_Root; ------------- @@ -1839,7 +1834,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is function Iterate_Children (Container : Tree; Parent : Cursor) - return Tree_Iterator_Interfaces.Reversible_Iterator'Class + return Tree_Iterator_Interfaces.Reversible_Iterator'Class is pragma Unreferenced (Container); begin @@ -2039,10 +2034,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is end Next; function Next - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor is - begin if Object.Container /= Position.Container then raise Program_Error; @@ -2201,7 +2195,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is -------------- overriding function Previous - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor is begin diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads index e014f82d453..797b6ea6214 100644 --- a/gcc/ada/a-cbmutr.ads +++ b/gcc/ada/a-cbmutr.ads @@ -182,7 +182,7 @@ package Ada.Containers.Bounded_Multiway_Trees is function Iterate_Children (Container : Tree; Parent : Cursor) - return Tree_Iterator_Interfaces.Reversible_Iterator'Class; + return Tree_Iterator_Interfaces.Reversible_Iterator'Class; function Child_Count (Parent : Cursor) return Count_Type; diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb index 1974c6cccef..674d2abee33 100644 --- a/gcc/ada/a-cborse.adb +++ b/gcc/ada/a-cborse.adb @@ -326,7 +326,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is function New_Node return Count_Type is Result : Count_Type; - begin Allocate (Target, Result); return Result; @@ -376,13 +375,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Ceiling (Container : Set; Item : Element_Type) return Cursor is Node : constant Count_Type := Element_Keys.Ceiling (Container, Item); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; ----------- @@ -425,10 +420,8 @@ package body Ada.Containers.Bounded_Ordered_Sets is begin if Capacity = 0 then C := Source.Length; - elsif Capacity >= Source.Length then C := Capacity; - else raise Capacity_Error with "Capacity value too small"; end if; @@ -479,7 +472,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is procedure Delete_First (Container : in out Set) is X : constant Count_Type := Container.First; - begin if X /= 0 then Tree_Operations.Delete_Node_Sans_Free (Container, X); @@ -493,7 +485,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is procedure Delete_Last (Container : in out Set) is X : constant Count_Type := Container.Last; - begin if X /= 0 then Tree_Operations.Delete_Node_Sans_Free (Container, X); @@ -533,13 +524,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Equivalent_Elements (Left, Right : Element_Type) return Boolean is begin - if Left < Right - or else Right < Left - then - return False; - else - return True; - end if; + return (if Left < Right or else Right < Left then False else True); end Equivalent_Elements; --------------------- @@ -559,13 +544,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Is_Equivalent_Node_Node (L, R : Node_Type) return Boolean is begin - if L.Element < R.Element then - return False; - elsif R.Element < L.Element then - return False; - else - return True; - end if; + return (if L.Element < R.Element then False + elsif R.Element < L.Element then False + else True); end Is_Equivalent_Node_Node; -- Start of processing for Equivalent_Sets @@ -580,7 +561,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is procedure Exclude (Container : in out Set; Item : Element_Type) is X : constant Count_Type := Element_Keys.Find (Container, Item); - begin if X /= 0 then Tree_Operations.Delete_Node_Sans_Free (Container, X); @@ -594,13 +574,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Find (Container : Set; Item : Element_Type) return Cursor is Node : constant Count_Type := Element_Keys.Find (Container, Item); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -609,23 +585,15 @@ package body Ada.Containers.Bounded_Ordered_Sets is function First (Container : Set) return Cursor is begin - if Container.First = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Container.First); + return (if Container.First = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Container.First)); end First; function First (Object : Iterator) return Cursor is begin - if Object.Container.First = 0 then - return No_Element; - else - return - Cursor'( - Object.Container.all'Unrestricted_Access, - Object.Container.First); - end if; + return (if Object.Container.First = 0 then No_Element + else Cursor'(Object.Container.all'Unrestricted_Access, + Object.Container.First)); end First; ------------------- @@ -647,13 +615,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Floor (Container : Set; Item : Element_Type) return Cursor is Node : constant Count_Type := Element_Keys.Floor (Container, Item); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ------------------ @@ -694,13 +658,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Ceiling (Container : Set; Key : Key_Type) return Cursor is Node : constant Count_Type := Key_Keys.Ceiling (Container, Key); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; -------------- @@ -749,13 +709,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Equivalent_Keys (Left, Right : Key_Type) return Boolean is begin - if Left < Right - or else Right < Left - then - return False; - else - return True; - end if; + return (if Left < Right or else Right < Left then False else True); end Equivalent_Keys; ------------- @@ -764,7 +718,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is procedure Exclude (Container : in out Set; Key : Key_Type) is X : constant Count_Type := Key_Keys.Find (Container, Key); - begin if X /= 0 then Tree_Operations.Delete_Node_Sans_Free (Container, X); @@ -778,13 +731,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Find (Container : Set; Key : Key_Type) return Cursor is Node : constant Count_Type := Key_Keys.Find (Container, Key); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -793,13 +742,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Floor (Container : Set; Key : Key_Type) return Cursor is Node : constant Count_Type := Key_Keys.Floor (Container, Key); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ------------------------- @@ -1069,7 +1014,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is function New_Node return Count_Type is Result : Count_Type; - begin Allocate (Container, Result); return Result; @@ -1133,7 +1077,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is function New_Node return Count_Type is Result : Count_Type; - begin Allocate (Dst_Set, Result); return Result; @@ -1287,22 +1230,15 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Last (Container : Set) return Cursor is begin - if Container.Last = 0 then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Container.Last); + return (if Container.Last = 0 then No_Element + else Cursor'(Container'Unrestricted_Access, Container.Last)); end Last; function Last (Object : Iterator) return Cursor is begin - if Object.Container.Last = 0 then - return No_Element; - else - return Cursor'( - Object.Container.all'Unrestricted_Access, - Object.Container.Last); - end if; + return (if Object.Container.Last = 0 then No_Element + else Cursor'(Object.Container.all'Unrestricted_Access, + Object.Container.Last)); end Last; ------------------ @@ -1388,7 +1324,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is function Next (Object : Iterator; Position : Cursor) return Cursor is pragma Unreferenced (Object); - begin return Next (Position); end Next; @@ -1427,13 +1362,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is Tree_Operations.Previous (Position.Container.all, Position.Node); - begin - if Node = 0 then - return No_Element; - end if; - - return Cursor'(Position.Container, Node); + return (if Node = 0 then No_Element + else Cursor'(Position.Container, Node)); end; end Previous; @@ -1466,7 +1397,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is declare S : Set renames Position.Container.all; - B : Natural renames S.Busy; L : Natural renames S.Lock; @@ -1608,11 +1538,10 @@ package body Ada.Containers.Bounded_Ordered_Sets is function New_Node return Count_Type is begin Node.Element := Item; - Node.Color := Red_Black_Trees.Red; - Node.Parent := 0; - Node.Right := 0; - Node.Left := 0; - + Node.Color := Red_Black_Trees.Red; + Node.Parent := 0; + Node.Right := 0; + Node.Left := 0; return Index; end New_Node; diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb index dd43229b5e2..6cee303fced 100644 --- a/gcc/ada/a-cihase.adb +++ b/gcc/ada/a-cihase.adb @@ -49,7 +49,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is overriding function First (Object : Iterator) return Cursor; overriding function Next - (Object : Iterator; + (Object : Iterator; Position : Cursor) return Cursor; ----------------------- @@ -426,8 +426,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is -- Equivalent_Elements -- ------------------------- - function Equivalent_Elements (Left, Right : Cursor) - return Boolean is + function Equivalent_Elements (Left, Right : Cursor) return Boolean is begin if Left.Node = null then raise Constraint_Error with @@ -457,8 +456,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Right.Node.Element.all); end Equivalent_Elements; - function Equivalent_Elements (Left : Cursor; Right : Element_Type) - return Boolean is + function Equivalent_Elements + (Left : Cursor; + Right : Element_Type) return Boolean + is begin if Left.Node = null then raise Constraint_Error with @@ -475,8 +476,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is return Equivalent_Elements (Left.Node.Element.all, Right); end Equivalent_Elements; - function Equivalent_Elements (Left : Element_Type; Right : Cursor) - return Boolean is + function Equivalent_Elements + (Left : Element_Type; + Right : Cursor) return Boolean + is begin if Right.Node = null then raise Constraint_Error with @@ -497,8 +500,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is -- Equivalent_Keys -- --------------------- - function Equivalent_Keys (Key : Element_Type; Node : Node_Access) - return Boolean is + function Equivalent_Keys + (Key : Element_Type; + Node : Node_Access) return Boolean + is begin return Equivalent_Elements (Key, Node.Element.all); end Equivalent_Keys; @@ -535,13 +540,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Item : Element_Type) return Cursor is Node : constant Node_Access := Element_Keys.Find (Container.HT, Item); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; -------------------- @@ -604,23 +605,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is function First (Container : Set) return Cursor is Node : constant Node_Access := HT_Ops.First (Container.HT); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end First; function First (Object : Iterator) return Cursor is Node : constant Node_Access := HT_Ops.First (Object.Container.HT); begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Object.Container, Node); + return (if Node = null then No_Element + else Cursor'(Object.Container, Node)); end First; ---------- @@ -750,7 +744,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is function New_Node (Next : Node_Access) return Node_Access is Element : Element_Access := new Element_Type'(New_Item); - begin return new Node_Type'(Element, Next); exception @@ -1025,13 +1018,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is declare HT : Hash_Table_Type renames Position.Container.HT; Node : constant Node_Access := HT_Ops.Next (HT, Position.Node); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Position.Container, Node); + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Next; @@ -1041,7 +1030,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is end Next; function Next - (Object : Iterator; + (Object : Iterator; Position : Cursor) return Cursor is begin @@ -1050,11 +1039,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is "Position cursor designates wrong set"; end if; - if Position.Node = null then - return No_Element; - end if; - - return Next (Position); + return (if Position.Node = null then No_Element else Next (Position)); end Next; ------------- @@ -1166,7 +1151,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is (Stream : not null access Root_Stream_Type'Class) return Node_Access is X : Element_Access := new Element_Type'(Element_Type'Input (Stream)); - begin return new Node_Type'(X, null); exception @@ -1183,9 +1167,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is (Container : aliased Set; Position : Cursor) return Constant_Reference_Type is - begin pragma Unreferenced (Container); - + begin return (Element => Position.Node.Element); end Constant_Reference; @@ -1301,8 +1284,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Iterate_Source_When_Empty_Target : declare procedure Process (Src_Node : Node_Access); - procedure Iterate is - new HT_Ops.Generic_Iteration (Process); + procedure Iterate is new HT_Ops.Generic_Iteration (Process); ------------- -- Process -- @@ -1535,12 +1517,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ------------ function To_Set (New_Item : Element_Type) return Set is - HT : Hash_Table_Type; - + HT : Hash_Table_Type; Node : Node_Access; Inserted : Boolean; pragma Unreferenced (Node, Inserted); - begin Insert (HT, New_Item, Node, Inserted); return Set'(Controlled with HT); @@ -1578,7 +1558,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is function New_Node (Next : Node_Access) return Node_Access is Tgt : Element_Access := new Element_Type'(Src); - begin return new Node_Type'(Tgt, Next); exception @@ -1655,14 +1634,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ------------- procedure Process (L_Node : Node_Access) is - Src : Element_Type renames L_Node.Element.all; - - J : constant Hash_Type := Hash (Src) mod Buckets'Length; - + Src : Element_Type renames L_Node.Element.all; + J : constant Hash_Type := Hash (Src) mod Buckets'Length; Bucket : Node_Access renames Buckets (J); - - Tgt : Element_Access := new Element_Type'(Src); - + Tgt : Element_Access := new Element_Type'(Src); begin Bucket := new Node_Type'(Tgt, Bucket); exception @@ -1940,13 +1915,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Keys.Find (Container.HT, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; --------- @@ -2106,7 +2077,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is function Reference_Preserving_Key (Container : aliased in out Set; - Key : Key_Type) return Reference_Type + Key : Key_Type) return Reference_Type is Position : constant Cursor := Find (Container, Key); begin diff --git a/gcc/ada/a-cihase.ads b/gcc/ada/a-cihase.ads index b055c1be153..860034469ea 100644 --- a/gcc/ada/a-cihase.ads +++ b/gcc/ada/a-cihase.ads @@ -414,13 +414,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is function Reference_Preserving_Key (Container : aliased in out Set; - Position : Cursor) - return Reference_Type; + Position : Cursor) return Reference_Type; function Reference_Preserving_Key (Container : aliased in out Set; - Key : Key_Type) - return Reference_Type; + Key : Key_Type) return Reference_Type; private type Reference_Type (Element : not null access Element_Type) @@ -428,7 +426,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is end Generic_Keys; private - pragma Inline (Next); type Node_Type; diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index c30abd08046..23d7a3502ec 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -279,8 +279,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is -- Adjust -- ------------ - procedure Adjust is - new Tree_Operations.Generic_Adjust (Copy_Tree); + procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree); procedure Adjust (Container : in out Map) is begin @@ -293,21 +292,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Ceiling (Container : Map; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; ----------- -- Clear -- ----------- - procedure Clear is - new Tree_Operations.Generic_Clear (Delete_Tree); + procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree); procedure Clear (Container : in out Map) is begin @@ -331,7 +325,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is (Container : Map; Key : Key_Type) return Constant_Reference_Type is - begin return (Element => Container.Element (Key)'Unrestricted_Access); + begin + return (Element => Container.Element (Key)'Unrestricted_Access); end Constant_Reference; -------------- @@ -350,6 +345,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Copy_Node (Source : Node_Access) return Node_Access is K : Key_Access := new Key_Type'(Source.Key.all); E : Element_Access; + begin E := new Element_Type'(Source.Element.all); @@ -418,7 +414,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is procedure Delete_First (Container : in out Map) is X : Node_Access := Container.Tree.First; - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); @@ -432,7 +427,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is procedure Delete_Last (Container : in out Map) is X : Node_Access := Container.Tree.Last; - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); @@ -479,13 +473,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Equivalent_Keys (Left, Right : Key_Type) return Boolean is begin - if Left < Right - or else Right < Left - then - return False; - else - return True; - end if; + return (if Left < Right or else Right < Left then False else True); end Equivalent_Keys; ------------- @@ -494,7 +482,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is procedure Exclude (Container : in out Map; Key : Key_Type) is X : Node_Access := Key_Ops.Find (Container.Tree, Key); - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); @@ -508,13 +495,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Find (Container : Map; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -523,25 +506,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function First (Container : Map) return Cursor is T : Tree_Type renames Container.Tree; - begin - if T.First = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, T.First); + return (if T.First = null then No_Element + else Cursor'(Container'Unrestricted_Access, T.First)); end First; function First (Object : Iterator) return Cursor is M : constant Map_Access := Object.Container; N : constant Node_Access := M.Tree.First; - begin - if N = null then - return No_Element; - else - return Cursor'(Object.Container.all'Unchecked_Access, N); - end if; + return (if N = null then No_Element + else Cursor'(Object.Container.all'Unchecked_Access, N)); end First; ------------------- @@ -580,13 +555,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Floor (Container : Map; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ---------- @@ -608,6 +579,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is begin Free_Key (X.Key); + exception when others => X.Key := null; @@ -625,6 +597,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is begin Free_Element (X.Element); + exception when others => X.Element := null; @@ -771,18 +744,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is -- Is_Equal_Node_Node -- ------------------------ - function Is_Equal_Node_Node - (L, R : Node_Access) return Boolean is + function Is_Equal_Node_Node (L, R : Node_Access) return Boolean is begin - if L.Key.all < R.Key.all then - return False; - - elsif R.Key.all < L.Key.all then - return False; - - else - return L.Element.all = R.Element.all; - end if; + return (if L.Key.all < R.Key.all then False + elsif R.Key.all < L.Key.all then False + else L.Element.all = R.Element.all); end Is_Equal_Node_Node; ------------------------- @@ -856,12 +822,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is is Node : constant Node_Access := Container.Tree.First; It : constant Iterator := (Container'Unrestricted_Access, Node); - begin return It; end Iterate; - function Iterate (Container : Map; Start : Cursor) + function Iterate + (Container : Map; + Start : Cursor) return Map_Iterator_Interfaces.Reversible_Iterator'class is It : constant Iterator := (Container'Unrestricted_Access, Start.Node); @@ -897,24 +864,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Last (Container : Map) return Cursor is T : Tree_Type renames Container.Tree; - begin - if T.Last = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, T.Last); + return (if T.Last = null then No_Element + else Cursor'(Container'Unrestricted_Access, T.Last)); end Last; function Last (Object : Iterator) return Cursor is M : constant Map_Access := Object.Container; N : constant Node_Access := M.Tree.Last; begin - if N = null then - return No_Element; - else - return Cursor'(Object.Container.all'Unchecked_Access, N); - end if; + return (if N = null then No_Element + else Cursor'(Object.Container.all'Unchecked_Access, N)); end Last; ------------------ @@ -969,8 +929,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is -- Move -- ---------- - procedure Move is - new Tree_Operations.Generic_Move (Clear); + procedure Move is new Tree_Operations.Generic_Move (Clear); procedure Move (Target : in out Map; Source : in out Map) is begin @@ -996,13 +955,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is declare Node : constant Node_Access := Tree_Operations.Next (Position.Node); - begin - if Node = null then - return No_Element; - else - return Cursor'(Position.Container, Node); - end if; + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Next; @@ -1016,11 +971,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : Cursor) return Cursor is begin - if Position.Node = null then - return No_Element; - else - return (Object.Container, Tree_Operations.Next (Position.Node)); - end if; + return (if Position.Node = null then No_Element + else (Object.Container, Tree_Operations.Next (Position.Node))); end Next; ------------ @@ -1051,13 +1003,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is declare Node : constant Node_Access := Tree_Operations.Previous (Position.Node); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Position.Container, Node); + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Previous; @@ -1071,11 +1019,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : Cursor) return Cursor is begin - if Position.Node = null then - return No_Element; - else - return (Object.Container, Tree_Operations.Previous (Position.Node)); - end if; + return + (if Position.Node = null then No_Element + else (Object.Container, Tree_Operations.Previous (Position.Node))); end Previous; ------------------- diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb index a330ed8b6c5..4257f0974e6 100644 --- a/gcc/ada/a-ciorse.adb +++ b/gcc/ada/a-ciorse.adb @@ -314,8 +314,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -- Adjust -- ------------ - procedure Adjust is - new Tree_Operations.Generic_Adjust (Copy_Tree); + procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree); procedure Adjust (Container : in out Set) is begin @@ -329,13 +328,9 @@ 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); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; ----------- @@ -433,7 +428,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is procedure Delete_First (Container : in out Set) is Tree : Tree_Type renames Container.Tree; X : Node_Access := Tree.First; - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Tree, X); @@ -448,7 +442,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is procedure Delete_Last (Container : in out Set) is Tree : Tree_Type renames Container.Tree; X : Node_Access := Tree.Last; - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Tree, X); @@ -466,8 +459,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end Difference; function Difference (Left, Right : Set) return Set is - Tree : constant Tree_Type := - Set_Ops.Difference (Left.Tree, Right.Tree); + Tree : constant Tree_Type := Set_Ops.Difference (Left.Tree, Right.Tree); begin return Set'(Controlled with Tree); end Difference; @@ -498,9 +490,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Equivalent_Elements (Left, Right : Element_Type) return Boolean is begin - if Left < Right - or else Right < Left - then + if Left < Right or else Right < Left then return False; else return True; @@ -547,7 +537,6 @@ 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); - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); @@ -577,11 +566,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function First (Container : Set) return Cursor is begin - if Container.Tree.First = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Container.Tree.First); + return + (if Container.Tree.First = null then No_Element + else Cursor'(Container'Unrestricted_Access, Container.Tree.First)); end First; function First (Object : Iterator) return Cursor is @@ -611,11 +598,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item); begin - if Node = null then - return No_Element; - else - return Cursor'(Container'Unrestricted_Access, Node); - end if; + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ---------- @@ -685,13 +669,9 @@ 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); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; -------------- @@ -741,9 +721,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Equivalent_Keys (Left, Right : Key_Type) return Boolean is begin - if Left < Right - or else Right < Left - then + if Left < Right or else Right < Left then return False; else return True; @@ -756,7 +734,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is procedure Exclude (Container : in out Set; Key : Key_Type) is X : Node_Access := Key_Keys.Find (Container.Tree, Key); - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); @@ -771,13 +748,9 @@ 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); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -787,13 +760,9 @@ 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); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ------------------------- @@ -802,7 +771,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Is_Greater_Key_Node (Left : Key_Type; - Right : Node_Access) return Boolean is + Right : Node_Access) return Boolean + is begin return Key (Right.Element.all) < Left; end Is_Greater_Key_Node; @@ -813,7 +783,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Is_Less_Key_Node (Left : Key_Type; - Right : Node_Access) return Boolean is + Right : Node_Access) return Boolean + is begin return Left < Key (Right.Element.all); end Is_Less_Key_Node; @@ -1179,7 +1150,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Is_Greater_Element_Node (Left : Element_Type; - Right : Node_Access) return Boolean is + Right : Node_Access) return Boolean + is begin -- e > node same as node < e @@ -1192,7 +1164,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Is_Less_Element_Node (Left : Element_Type; - Right : Node_Access) return Boolean is + Right : Node_Access) return Boolean + is begin return Left < Right.Element.all; end Is_Less_Element_Node; @@ -1283,22 +1256,16 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Last (Container : Set) return Cursor is begin - if Container.Tree.Last = null then - return No_Element; - else - return Cursor'(Container'Unrestricted_Access, Container.Tree.Last); - end if; + return + (if Container.Tree.Last = null then No_Element + else Cursor'(Container'Unrestricted_Access, Container.Tree.Last)); end Last; function Last (Object : Iterator) return Cursor is begin - if Object.Container.Tree.Last = null then - return No_Element; - else - return Cursor'( - Object.Container.all'Unrestricted_Access, - Object.Container.Tree.Last); - end if; + return (if Object.Container.Tree.Last = null then No_Element + else Cursor'(Object.Container.all'Unrestricted_Access, + Object.Container.Tree.Last)); end Last; ------------------ @@ -1336,8 +1303,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -- Move -- ---------- - procedure Move is - new Tree_Operations.Generic_Move (Clear); + procedure Move is new Tree_Operations.Generic_Move (Clear); procedure Move (Target : in out Set; Source : in out Set) is begin @@ -1369,13 +1335,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is declare Node : constant Node_Access := Tree_Operations.Next (Position.Node); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Position.Container, Node); + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Next; @@ -1431,13 +1393,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is declare Node : constant Node_Access := Tree_Operations.Previous (Position.Node); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Position.Container, Node); + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Previous; @@ -1608,15 +1566,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is pragma Inline (New_Node); procedure Local_Insert_Post is - new Element_Keys.Generic_Insert_Post (New_Node); + new Element_Keys.Generic_Insert_Post (New_Node); procedure Local_Insert_Sans_Hint is - new Element_Keys.Generic_Conditional_Insert (Local_Insert_Post); + new Element_Keys.Generic_Conditional_Insert (Local_Insert_Post); procedure Local_Insert_With_Hint is - new Element_Keys.Generic_Conditional_Insert_With_Hint - (Local_Insert_Post, - Local_Insert_Sans_Hint); + new Element_Keys.Generic_Conditional_Insert_With_Hint + (Local_Insert_Post, + Local_Insert_Sans_Hint); -------------- -- New_Node -- @@ -1629,7 +1587,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is Node.Parent := null; Node.Right := null; Node.Left := null; - return Node; end New_Node; @@ -1829,12 +1786,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ------------ function To_Set (New_Item : Element_Type) return Set is - Tree : Tree_Type; - + Tree : Tree_Type; Node : Node_Access; Inserted : Boolean; pragma Unreferenced (Node, Inserted); - begin Insert_Sans_Hint (Tree, New_Item, Node, Inserted); return Set'(Controlled with Tree); diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb index 0fcb3d6d51c..86be79ffc35 100644 --- a/gcc/ada/a-comutr.adb +++ b/gcc/ada/a-comutr.adb @@ -48,16 +48,16 @@ package body Ada.Containers.Multiway_Trees is overriding function First (Object : Iterator) return Cursor; overriding function Next - (Object : Iterator; + (Object : Iterator; Position : Cursor) return Cursor; overriding function First (Object : Child_Iterator) return Cursor; overriding function Next - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor; overriding function Previous - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor; overriding function Last (Object : Child_Iterator) return Cursor; @@ -327,11 +327,8 @@ package body Ada.Containers.Multiway_Trees is function Child_Count (Parent : Cursor) return Count_Type is begin - if Parent = No_Element then - return 0; - else - return Child_Count (Parent.Node.Children); - end if; + return (if Parent = No_Element + then 0 else Child_Count (Parent.Node.Children)); end Child_Count; function Child_Count (Children : Children_Type) return Count_Type is @@ -1010,12 +1007,10 @@ package body Ada.Containers.Multiway_Trees is -- raise Program_Error with "Position cursor not in container"; -- end if; - if Is_Root (Position) then - Result := Find_In_Children (Position.Node, Item); - - else - Result := Find_In_Subtree (Position.Node, Item); - end if; + Result := + (if Is_Root (Position) + then Find_In_Children (Position.Node, Item) + else Find_In_Subtree (Position.Node, Item)); if Result = null then return No_Element; @@ -1437,7 +1432,7 @@ package body Ada.Containers.Multiway_Trees is function Iterate_Children (Container : Tree; Parent : Cursor) - return Tree_Iterator_Interfaces.Reversible_Iterator'Class + return Tree_Iterator_Interfaces.Reversible_Iterator'Class is pragma Unreferenced (Container); begin @@ -1457,8 +1452,8 @@ package body Ada.Containers.Multiway_Trees is end Iterate_Subtree; procedure Iterate_Subtree - (Position : Cursor; - Process : not null access procedure (Position : Cursor)) + (Position : Cursor; + Process : not null access procedure (Position : Cursor)) is begin if Position = No_Element then @@ -1515,6 +1510,7 @@ package body Ada.Containers.Multiway_Trees is function Last_Child (Parent : Cursor) return Cursor is Node : Tree_Node_Access; + begin if Parent = No_Element then raise Constraint_Error with "Parent cursor has no element"; @@ -1575,7 +1571,7 @@ package body Ada.Containers.Multiway_Trees is ---------- function Next - (Object : Iterator; + (Object : Iterator; Position : Cursor) return Cursor is T : Tree renames Position.Container.all; @@ -1635,18 +1631,12 @@ package body Ada.Containers.Multiway_Trees is end Next; function Next - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor is C : constant Tree_Node_Access := Position.Node.Next; - begin - if C = null then - return No_Element; - - else - return (Object.Container, C); - end if; + return (if C = null then No_Element else (Object.Container, C)); end Next; ------------------ @@ -1773,18 +1763,12 @@ package body Ada.Containers.Multiway_Trees is -------------- overriding function Previous - (Object : Child_Iterator; + (Object : Child_Iterator; Position : Cursor) return Cursor is C : constant Tree_Node_Access := Position.Node.Prev; - begin - if C = null then - return No_Element; - - else - return (Object.Container, C); - end if; + return (if C = null then No_Element else (Object.Container, C)); end Previous; ---------------------- @@ -1793,15 +1777,10 @@ package body Ada.Containers.Multiway_Trees is function Previous_Sibling (Position : Cursor) return Cursor is begin - if Position = No_Element then - return No_Element; - end if; - - if Position.Node.Prev = null then - return No_Element; - end if; - - return Cursor'(Position.Container, Position.Node.Prev); + return + (if Position = No_Element then No_Element + elsif Position.Node.Prev = null then No_Element + else Cursor'(Position.Container, Position.Node.Prev)); end Previous_Sibling; procedure Previous_Sibling (Position : in out Cursor) is diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb index d52ed67c9a0..915eed62117 100644 --- a/gcc/ada/a-coorse.adb +++ b/gcc/ada/a-coorse.adb @@ -288,13 +288,9 @@ package body Ada.Containers.Ordered_Sets is function Ceiling (Container : Set; Item : Element_Type) return Cursor is Node : constant Node_Access := Element_Keys.Ceiling (Container.Tree, Item); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; ----------- @@ -385,7 +381,6 @@ package body Ada.Containers.Ordered_Sets is procedure Delete_First (Container : in out Set) is Tree : Tree_Type renames Container.Tree; X : Node_Access := Tree.First; - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Tree, X); @@ -400,7 +395,6 @@ package body Ada.Containers.Ordered_Sets is procedure Delete_Last (Container : in out Set) is Tree : Tree_Type renames Container.Tree; X : Node_Access := Tree.Last; - begin if X /= null then Tree_Operations.Delete_Node_Sans_Free (Tree, X); @@ -446,13 +440,7 @@ package body Ada.Containers.Ordered_Sets is function Equivalent_Elements (Left, Right : Element_Type) return Boolean is begin - if Left < Right - or else Right < Left - then - return False; - else - return True; - end if; + return (if Left < Right or else Right < Left then False else True); end Equivalent_Elements; --------------------- @@ -472,13 +460,9 @@ package body Ada.Containers.Ordered_Sets is function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is begin - if L.Element < R.Element then - return False; - elsif R.Element < L.Element then - return False; - else - return True; - end if; + return (if L.Element < R.Element then False + elsif R.Element < L.Element then False + else True); end Is_Equivalent_Node_Node; -- Start of processing for Equivalent_Sets @@ -508,13 +492,9 @@ package body Ada.Containers.Ordered_Sets is function Find (Container : Set; Item : Element_Type) return Cursor is Node : constant Node_Access := Element_Keys.Find (Container.Tree, Item); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -523,23 +503,16 @@ package body Ada.Containers.Ordered_Sets is function First (Container : Set) return Cursor is begin - if Container.Tree.First = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Container.Tree.First); + return + (if Container.Tree.First = null then No_Element + else Cursor'(Container'Unrestricted_Access, Container.Tree.First)); end First; function First (Object : Iterator) return Cursor is begin - if Object.Container = null then - return No_Element; - else - return - Cursor'( - Object.Container.all'Unrestricted_Access, - Object.Container.Tree.First); - end if; + return (if Object.Container = null then No_Element + else Cursor'(Object.Container.all'Unrestricted_Access, + Object.Container.Tree.First)); end First; ------------------- @@ -562,13 +535,9 @@ package body Ada.Containers.Ordered_Sets is function Floor (Container : Set; Item : Element_Type) return Cursor is Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ---------- @@ -578,13 +547,11 @@ package body Ada.Containers.Ordered_Sets is procedure Free (X : in out Node_Access) is procedure Deallocate is new Ada.Unchecked_Deallocation (Node_Type, Node_Access); - begin if X /= null then X.Parent := X; - X.Left := X; - X.Right := X; - + X.Left := X; + X.Right := X; Deallocate (X); end if; end Free; @@ -627,13 +594,9 @@ package body Ada.Containers.Ordered_Sets is function Ceiling (Container : Set; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Keys.Ceiling (Container.Tree, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Ceiling; -------------- @@ -683,13 +646,7 @@ package body Ada.Containers.Ordered_Sets is function Equivalent_Keys (Left, Right : Key_Type) return Boolean is begin - if Left < Right - or else Right < Left - then - return False; - else - return True; - end if; + return (if Left < Right or else Right < Left then False else True); end Equivalent_Keys; ------------- @@ -698,7 +655,6 @@ package body Ada.Containers.Ordered_Sets is procedure Exclude (Container : in out Set; Key : Key_Type) is X : Node_Access := Key_Keys.Find (Container.Tree, Key); - begin if X /= null then Delete_Node_Sans_Free (Container.Tree, X); @@ -712,13 +668,9 @@ package body Ada.Containers.Ordered_Sets is function Find (Container : Set; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Find; ----------- @@ -727,13 +679,9 @@ package body Ada.Containers.Ordered_Sets is function Floor (Container : Set; Key : Key_Type) return Cursor is Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Container'Unrestricted_Access, Node); + return (if Node = null then No_Element + else Cursor'(Container'Unrestricted_Access, Node)); end Floor; ------------------------- @@ -1214,22 +1162,16 @@ package body Ada.Containers.Ordered_Sets is function Last (Container : Set) return Cursor is begin - if Container.Tree.Last = null then - return No_Element; - else - return Cursor'(Container'Unrestricted_Access, Container.Tree.Last); - end if; + return + (if Container.Tree.Last = null then No_Element + else Cursor'(Container'Unrestricted_Access, Container.Tree.Last)); end Last; function Last (Object : Iterator) return Cursor is begin - if Object.Container = null then - return No_Element; - else - return Cursor'( - Object.Container.all'Unrestricted_Access, - Object.Container.Tree.Last); - end if; + return (if Object.Container = null then No_Element + else Cursor'(Object.Container.all'Unrestricted_Access, + Object.Container.Tree.Last)); end Last; ------------------ @@ -1267,8 +1209,7 @@ package body Ada.Containers.Ordered_Sets is -- Move -- ---------- - procedure Move is - new Tree_Operations.Generic_Move (Clear); + procedure Move is new Tree_Operations.Generic_Move (Clear); procedure Move (Target : in out Set; Source : in out Set) is begin @@ -1291,13 +1232,9 @@ package body Ada.Containers.Ordered_Sets is declare Node : constant Node_Access := Tree_Operations.Next (Position.Node); - begin - if Node = null then - return No_Element; - end if; - - return Cursor'(Position.Container, Node); + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Next; @@ -1347,11 +1284,8 @@ package body Ada.Containers.Ordered_Sets is Node : constant Node_Access := Tree_Operations.Previous (Position.Node); begin - if Node = null then - return No_Element; - else - return Cursor'(Position.Container, Node); - end if; + return (if Node = null then No_Element + else Cursor'(Position.Container, Node)); end; end Previous; @@ -1429,11 +1363,9 @@ package body Ada.Containers.Ordered_Sets is (Stream : not null access Root_Stream_Type'Class) return Node_Access is Node : Node_Access := new Node_Type; - begin Element_Type'Read (Stream, Node.Element); return Node; - exception when others => Free (Node); @@ -1532,11 +1464,10 @@ package body Ada.Containers.Ordered_Sets is function New_Node return Node_Access is begin Node.Element := Item; - Node.Color := Red; - Node.Parent := null; - Node.Right := null; - Node.Left := null; - + Node.Color := Red; + Node.Parent := null; + Node.Right := null; + Node.Left := null; return Node; end New_Node; @@ -1547,9 +1478,7 @@ package body Ada.Containers.Ordered_Sets is -- Start of processing for Replace_Element begin - if Item < Node.Element - or else Node.Element < Item - then + if Item < Node.Element or else Node.Element < Item then null; else diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a9a45bc6445..a34be0cc3da 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -452,7 +452,18 @@ package body Sem_Ch6 is -- incompatibility with Ada 95. Not clear whether this should be -- enforced yet or perhaps controllable with special switch. ??? - if Is_Limited_Type (R_Type) + -- A limited interface that is not immutably limited is OK. + + if Is_Limited_Interface (R_Type) + and then + not (Is_Task_Interface (R_Type) + or else Is_Protected_Interface (R_Type) + or else Is_Synchronized_Interface (R_Type)) + then + null; + + elsif Is_Limited_Type (R_Type) + and then not Is_Interface (R_Type) and then Comes_From_Source (N) and then not In_Instance_Body and then not OK_For_Limited_Init_In_05 (R_Type, Expr) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9ce5282d5b8..7f10c266225 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -64,6 +64,7 @@ with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Intr; use Sem_Intr; with Sem_Util; use Sem_Util; +with Targparm; use Targparm; with Sem_Type; use Sem_Type; with Sem_Warn; use Sem_Warn; with Sinfo; use Sinfo; @@ -4874,13 +4875,33 @@ package body Sem_Res is (Is_Real_Type (Etype (Rop)) and then Expr_Value_R (Rop) = Ureal_0)) then - -- Specialize the warning message according to the operation + -- Specialize the warning message according to the operation. + -- The following warnings are for the case case Nkind (N) is when N_Op_Divide => - Apply_Compile_Time_Constraint_Error - (N, "division by zero?", CE_Divide_By_Zero, - Loc => Sloc (Right_Opnd (N))); + + -- For division, we have two cases, for float division + -- of an unconstrained float type, on a machine where + -- Machine_Overflows is false, we don't get an exception + -- at run-time, but rather an infinity or Nan. The Nan + -- case is pretty obscure, so just warn about infinities. + + if Is_Floating_Point_Type (Typ) + and then not Is_Constrained (Typ) + and then not Machine_Overflows_On_Target + then + Error_Msg_N + ("float division by zero, " & + "may generate '+'/'- infinity?", Right_Opnd (N)); + + -- For all other cases, we get a Constraint_Error + + else + Apply_Compile_Time_Constraint_Error + (N, "division by zero?", CE_Divide_By_Zero, + Loc => Sloc (Right_Opnd (N))); + end if; when N_Op_Rem => Apply_Compile_Time_Constraint_Error