diff options
Diffstat (limited to 'gcc/ada/a-ciorma.adb')
| -rw-r--r-- | gcc/ada/a-ciorma.adb | 338 |
1 files changed, 132 insertions, 206 deletions
diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index d06d8fedc1d..3d4a92f7f2e 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,6 +29,8 @@ with Ada.Unchecked_Deallocation; +with Ada.Containers.Helpers; use Ada.Containers.Helpers; + with Ada.Containers.Red_Black_Trees.Generic_Operations; pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Operations); @@ -41,6 +43,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is pragma Annotate (CodePeer, Skip_Analysis); pragma Suppress (All_Checks); + pragma Warnings (Off, "variable ""Busy*"" is not referenced"); + pragma Warnings (Off, "variable ""Lock*"" is not referenced"); + -- See comment in Ada.Containers.Helpers + ----------------------------- -- Node Access Subprograms -- ----------------------------- @@ -132,19 +138,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function "<" (Left, Right : Cursor) return Boolean is begin - if Left.Node = null then + if Checks and then Left.Node = null then raise Constraint_Error with "Left cursor of ""<"" equals No_Element"; end if; - if Right.Node = null then + if Checks and then Right.Node = null then raise Constraint_Error with "Right cursor of ""<"" equals No_Element"; end if; - if Left.Node.Key = null then + if Checks and then Left.Node.Key = null then raise Program_Error with "Left cursor in ""<"" is bad"; end if; - if Right.Node.Key = null then + if Checks and then Right.Node.Key = null then raise Program_Error with "Right cursor in ""<"" is bad"; end if; @@ -159,11 +165,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function "<" (Left : Cursor; Right : Key_Type) return Boolean is begin - if Left.Node = null then + if Checks and then Left.Node = null then raise Constraint_Error with "Left cursor of ""<"" equals No_Element"; end if; - if Left.Node.Key = null then + if Checks and then Left.Node.Key = null then raise Program_Error with "Left cursor in ""<"" is bad"; end if; @@ -175,11 +181,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function "<" (Left : Key_Type; Right : Cursor) return Boolean is begin - if Right.Node = null then + if Checks and then Right.Node = null then raise Constraint_Error with "Right cursor of ""<"" equals No_Element"; end if; - if Right.Node.Key = null then + if Checks and then Right.Node.Key = null then raise Program_Error with "Right cursor in ""<"" is bad"; end if; @@ -204,19 +210,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function ">" (Left, Right : Cursor) return Boolean is begin - if Left.Node = null then + if Checks and then Left.Node = null then raise Constraint_Error with "Left cursor of "">"" equals No_Element"; end if; - if Right.Node = null then + if Checks and then Right.Node = null then raise Constraint_Error with "Right cursor of "">"" equals No_Element"; end if; - if Left.Node.Key = null then + if Checks and then Left.Node.Key = null then raise Program_Error with "Left cursor in ""<"" is bad"; end if; - if Right.Node.Key = null then + if Checks and then Right.Node.Key = null then raise Program_Error with "Right cursor in ""<"" is bad"; end if; @@ -231,11 +237,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function ">" (Left : Cursor; Right : Key_Type) return Boolean is begin - if Left.Node = null then + if Checks and then Left.Node = null then raise Constraint_Error with "Left cursor of "">"" equals No_Element"; end if; - if Left.Node.Key = null then + if Checks and then Left.Node.Key = null then raise Program_Error with "Left cursor in ""<"" is bad"; end if; @@ -247,11 +253,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function ">" (Left : Key_Type; Right : Cursor) return Boolean is begin - if Right.Node = null then + if Checks and then Right.Node = null then raise Constraint_Error with "Right cursor of "">"" equals No_Element"; end if; - if Right.Node.Key = null then + if Checks and then Right.Node.Key = null then raise Program_Error with "Right cursor in ""<"" is bad"; end if; @@ -272,20 +278,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Adjust (Container.Tree); end Adjust; - procedure Adjust (Control : in out Reference_Control_Type) is - begin - if Control.Container /= null then - declare - T : Tree_Type renames Control.Container.all.Tree; - B : Natural renames T.Busy; - L : Natural renames T.Lock; - begin - B := B + 1; - L := L + 1; - end; - end if; - end Adjust; - ------------ -- Assign -- ------------ @@ -357,17 +349,18 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : Cursor) return Constant_Reference_Type is begin - if Position.Container = null then + if Checks and then Position.Container = null then raise Constraint_Error with "Position cursor has no element"; end if; - if Position.Container /= Container'Unrestricted_Access then + if Checks and then Position.Container /= Container'Unrestricted_Access + then raise Program_Error with "Position cursor designates wrong map"; end if; - if Position.Node.Element = null then + if Checks and then Position.Node.Element = null then raise Program_Error with "Node has no element"; end if; @@ -375,16 +368,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is "Position cursor in Constant_Reference is bad"); declare - T : Tree_Type renames Container'Unrestricted_Access.all.Tree; - B : Natural renames T.Busy; - L : Natural renames T.Lock; + TC : constant Tamper_Counts_Access := + Container.Tree.TC'Unrestricted_Access; begin return R : constant Constant_Reference_Type := (Element => Position.Node.Element.all'Access, - Control => (Controlled with Container'Unrestricted_Access)) + Control => (Controlled with TC)) do - B := B + 1; - L := L + 1; + Lock (TC.all); end return; end; end Constant_Reference; @@ -396,25 +387,23 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "key not in map"; end if; - if Node.Element = null then + if Checks and then Node.Element = null then raise Program_Error with "Node has no element"; end if; declare - T : Tree_Type renames Container'Unrestricted_Access.all.Tree; - B : Natural renames T.Busy; - L : Natural renames T.Lock; + TC : constant Tamper_Counts_Access := + Container.Tree.TC'Unrestricted_Access; begin return R : constant Constant_Reference_Type := (Element => Node.Element.all'Access, - Control => (Controlled with Container'Unrestricted_Access)) + Control => (Controlled with TC)) do - B := B + 1; - L := L + 1; + Lock (TC.all); end return; end; end Constant_Reference; @@ -473,18 +462,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : in out Cursor) is begin - if Position.Node = null then + if Checks and then Position.Node = null then raise Constraint_Error with "Position cursor of Delete equals No_Element"; end if; - if Position.Node.Key = null - or else Position.Node.Element = null + if Checks and then + (Position.Node.Key = null or else Position.Node.Element = null) then raise Program_Error with "Position cursor of Delete is bad"; end if; - if Position.Container /= Container'Unrestricted_Access then + if Checks and then Position.Container /= Container'Unrestricted_Access + then raise Program_Error with "Position cursor of Delete designates wrong map"; end if; @@ -502,7 +492,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is X : Node_Access := Key_Ops.Find (Container.Tree, Key); begin - if X = null then + if Checks and then X = null then raise Constraint_Error with "key not in map"; end if; @@ -542,12 +532,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Element (Position : Cursor) return Element_Type is begin - if Position.Node = null then + if Checks and then Position.Node = null then raise Constraint_Error with "Position cursor of function Element equals No_Element"; end if; - if Position.Node.Element = null then + if Checks and then Position.Node.Element = null then raise Program_Error with "Position cursor of function Element is bad"; end if; @@ -562,7 +552,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "key not in map"; end if; @@ -598,27 +588,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is procedure Finalize (Object : in out Iterator) is begin if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Tree.Busy; - begin - B := B - 1; - end; - end if; - end Finalize; - - procedure Finalize (Control : in out Reference_Control_Type) is - begin - if Control.Container /= null then - declare - T : Tree_Type renames Control.Container.all.Tree; - B : Natural renames T.Busy; - L : Natural renames T.Lock; - begin - B := B - 1; - L := L - 1; - end; - - Control.Container := null; + Unbusy (Object.Container.Tree.TC); end if; end Finalize; @@ -673,11 +643,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function First_Element (Container : Map) return Element_Type is T : Tree_Type renames Container.Tree; begin - if T.First = null then + if Checks and then T.First = null then raise Constraint_Error with "map is empty"; - else - return T.First.Element.all; end if; + + return T.First.Element.all; end First_Element; --------------- @@ -687,11 +657,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function First_Key (Container : Map) return Key_Type is T : Tree_Type renames Container.Tree; begin - if T.First = null then + if Checks and then T.First = null then raise Constraint_Error with "map is empty"; - else - return T.First.Key.all; end if; + + return T.First.Key.all; end First_Key; ----------- @@ -754,6 +724,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Deallocate (X); end Free; + ------------------------ + -- Get_Element_Access -- + ------------------------ + + function Get_Element_Access + (Position : Cursor) return not null Element_Access is + begin + return Position.Node.Element; + end Get_Element_Access; + ----------------- -- Has_Element -- ----------------- @@ -782,10 +762,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Insert (Container, Key, New_Item, Position, Inserted); if not Inserted then - if Container.Tree.Lock > 0 then - raise Program_Error with - "attempt to tamper with elements (map is locked)"; - end if; + TE_Check (Container.Tree.TC); K := Position.Node.Key; E := Position.Node.Element; @@ -886,7 +863,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is begin Insert (Container, Key, New_Item, Position, Inserted); - if not Inserted then + if Checks and then not Inserted then raise Constraint_Error with "key already in map"; end if; end Insert; @@ -959,30 +936,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Process (Cursor'(Container'Unrestricted_Access, Node)); end Process_Node; - B : Natural renames Container'Unrestricted_Access.all.Tree.Busy; + Busy : With_Busy (Container.Tree.TC'Unrestricted_Access); -- Start of processing for Iterate begin - B := B + 1; - - begin - Local_Iterate (Container.Tree); - - exception - when others => - B := B - 1; - raise; - end; - - B := B - 1; + Local_Iterate (Container.Tree); end Iterate; function Iterate (Container : Map) return Map_Iterator_Interfaces.Reversible_Iterator'Class is - B : Natural renames Container'Unrestricted_Access.all.Tree.Busy; - begin -- The value of the Node component influences the behavior of the First -- and Last selector functions of the iterator object. When the Node @@ -999,7 +963,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Container => Container'Unrestricted_Access, Node => null) do - B := B + 1; + Busy (Container.Tree.TC'Unrestricted_Access.all); end return; end Iterate; @@ -1008,8 +972,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Start : Cursor) return Map_Iterator_Interfaces.Reversible_Iterator'Class is - B : Natural renames Container'Unrestricted_Access.all.Tree.Busy; - begin -- It was formerly the case that when Start = No_Element, the partial -- iterator was defined to behave the same as for a complete iterator, @@ -1022,12 +984,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is -- however, that it is not possible to use a partial iterator to specify -- an empty sequence of items. - if Start = No_Element then + if Checks and then Start = No_Element then raise Constraint_Error with "Start position for iterator equals No_Element"; end if; - if Start.Container /= Container'Unrestricted_Access then + if Checks and then Start.Container /= Container'Unrestricted_Access then raise Program_Error with "Start cursor of Iterate designates wrong map"; end if; @@ -1049,7 +1011,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Container => Container'Unrestricted_Access, Node => Start.Node) do - B := B + 1; + Busy (Container.Tree.TC'Unrestricted_Access.all); end return; end Iterate; @@ -1059,12 +1021,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function Key (Position : Cursor) return Key_Type is begin - if Position.Node = null then + if Checks and then Position.Node = null then raise Constraint_Error with "Position cursor of function Key equals No_Element"; end if; - if Position.Node.Key = null then + if Checks and then Position.Node.Key = null then raise Program_Error with "Position cursor of function Key is bad"; end if; @@ -1116,7 +1078,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is T : Tree_Type renames Container.Tree; begin - if T.Last = null then + if Checks and then T.Last = null then raise Constraint_Error with "map is empty"; end if; @@ -1131,7 +1093,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is T : Tree_Type renames Container.Tree; begin - if T.Last = null then + if Checks and then T.Last = null then raise Constraint_Error with "map is empty"; end if; @@ -1206,7 +1168,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is return No_Element; end if; - if Position.Container /= Object.Container then + if Checks and then Position.Container /= Object.Container then raise Program_Error with "Position cursor of Next designates wrong map"; end if; @@ -1262,7 +1224,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is return No_Element; end if; - if Position.Container /= Object.Container then + if Checks and then Position.Container /= Object.Container then raise Program_Error with "Position cursor of Previous designates wrong map"; end if; @@ -1270,6 +1232,21 @@ package body Ada.Containers.Indefinite_Ordered_Maps is return Previous (Position); end Previous; + ---------------------- + -- Pseudo_Reference -- + ---------------------- + + function Pseudo_Reference + (Container : aliased Map'Class) return Reference_Control_Type + is + TC : constant Tamper_Counts_Access := + Container.Tree.TC'Unrestricted_Access; + begin + return R : constant Reference_Control_Type := (Controlled with TC) do + Lock (TC.all); + end return; + end Pseudo_Reference; + ------------------- -- Query_Element -- ------------------- @@ -1280,13 +1257,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Element : Element_Type)) is begin - if Position.Node = null then + if Checks and then Position.Node = null then 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 + if Checks and then + (Position.Node.Key = null or else Position.Node.Element = null) then raise Program_Error with "Position cursor of Query_Element is bad"; @@ -1297,28 +1274,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is declare T : Tree_Type renames Position.Container.Tree; - - B : Natural renames T.Busy; - L : Natural renames T.Lock; - + Lock : With_Lock (T.TC'Unrestricted_Access); + K : Key_Type renames Position.Node.Key.all; + E : Element_Type renames Position.Node.Element.all; begin - B := B + 1; - L := L + 1; - - declare - K : Key_Type renames Position.Node.Key.all; - E : Element_Type renames Position.Node.Element.all; - begin - Process (K, E); - exception - when others => - L := L - 1; - B := B - 1; - raise; - end; - - L := L - 1; - B := B - 1; + Process (K, E); end; end Query_Element; @@ -1394,17 +1354,18 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : Cursor) return Reference_Type is begin - if Position.Container = null then + if Checks and then Position.Container = null then raise Constraint_Error with "Position cursor has no element"; end if; - if Position.Container /= Container'Unrestricted_Access then + if Checks and then Position.Container /= Container'Unrestricted_Access + then raise Program_Error with "Position cursor designates wrong map"; end if; - if Position.Node.Element = null then + if Checks and then Position.Node.Element = null then raise Program_Error with "Node has no element"; end if; @@ -1412,16 +1373,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is "Position cursor in function Reference is bad"); declare - T : Tree_Type renames Container'Unrestricted_Access.all.Tree; - B : Natural renames T.Busy; - L : Natural renames T.Lock; + TC : constant Tamper_Counts_Access := + Container.Tree.TC'Unrestricted_Access; begin return R : constant Reference_Type := (Element => Position.Node.Element.all'Access, - Control => (Controlled with Position.Container)) + Control => (Controlled with TC)) do - B := B + 1; - L := L + 1; + Lock (TC.all); end return; end; end Reference; @@ -1433,25 +1392,23 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "key not in map"; end if; - if Node.Element = null then + if Checks and then Node.Element = null then raise Program_Error with "Node has no element"; end if; declare - T : Tree_Type renames Container'Unrestricted_Access.all.Tree; - B : Natural renames T.Busy; - L : Natural renames T.Lock; + TC : constant Tamper_Counts_Access := + Container.Tree.TC'Unrestricted_Access; begin return R : constant Reference_Type := (Element => Node.Element.all'Access, - Control => (Controlled with Container'Unrestricted_Access)) + Control => (Controlled with TC)) do - B := B + 1; - L := L + 1; + Lock (TC.all); end return; end; end Reference; @@ -1471,14 +1428,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is E : Element_Access; begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "key not in map"; end if; - if Container.Tree.Lock > 0 then - raise Program_Error with - "attempt to tamper with elements (map is locked)"; - end if; + TE_Check (Container.Tree.TC); K := Node.Key; E := Node.Element; @@ -1515,27 +1469,25 @@ package body Ada.Containers.Indefinite_Ordered_Maps is New_Item : Element_Type) is begin - if Position.Node = null then + if Checks and then Position.Node = null then 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 + if Checks and then + (Position.Node.Key = null or else Position.Node.Element = null) then raise Program_Error with "Position cursor of Replace_Element is bad"; end if; - if Position.Container /= Container'Unrestricted_Access then + if Checks and then Position.Container /= Container'Unrestricted_Access + then raise Program_Error with "Position cursor of Replace_Element designates wrong map"; end if; - if Container.Tree.Lock > 0 then - raise Program_Error with - "attempt to tamper with elements (map is locked)"; - end if; + TE_Check (Container.Tree.TC); pragma Assert (Vet (Container.Tree, Position.Node), "Position cursor of Replace_Element is bad"); @@ -1578,22 +1530,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Process (Cursor'(Container'Unrestricted_Access, Node)); end Process_Node; - B : Natural renames Container.Tree'Unrestricted_Access.all.Busy; + Busy : With_Busy (Container.Tree.TC'Unrestricted_Access); -- Start of processing for Reverse_Iterate begin - B := B + 1; - - begin - Local_Reverse_Iterate (Container.Tree); - exception - when others => - B := B - 1; - raise; - end; - - B := B - 1; + Local_Reverse_Iterate (Container.Tree); end Reverse_Iterate; ----------- @@ -1652,19 +1594,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Element : in out Element_Type)) is begin - if Position.Node = null then + if Checks and then Position.Node = null then 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 + if Checks and then + (Position.Node.Key = null or else Position.Node.Element = null) then raise Program_Error with "Position cursor of Update_Element is bad"; end if; - if Position.Container /= Container'Unrestricted_Access then + if Checks and then Position.Container /= Container'Unrestricted_Access + then raise Program_Error with "Position cursor of Update_Element designates wrong map"; end if; @@ -1674,28 +1617,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is declare T : Tree_Type renames Position.Container.Tree; - - B : Natural renames T.Busy; - L : Natural renames T.Lock; - + Lock : With_Lock (T.TC'Unrestricted_Access); + K : Key_Type renames Position.Node.Key.all; + E : Element_Type renames Position.Node.Element.all; begin - B := B + 1; - L := L + 1; - - declare - K : Key_Type renames Position.Node.Key.all; - E : Element_Type renames Position.Node.Element.all; - begin - Process (K, E); - exception - when others => - L := L - 1; - B := B - 1; - raise; - end; - - L := L - 1; - B := B - 1; + Process (K, E); end; end Update_Element; |