diff options
Diffstat (limited to 'gcc/ada/a-cohama.adb')
| -rw-r--r-- | gcc/ada/a-cohama.adb | 231 |
1 files changed, 72 insertions, 159 deletions
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb index 6fe9bfd576b..969bf9be122 100644 --- a/gcc/ada/a-cohama.adb +++ b/gcc/ada/a-cohama.adb @@ -35,12 +35,18 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Operations); with Ada.Containers.Hash_Tables.Generic_Keys; pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys); +with Ada.Containers.Helpers; use Ada.Containers.Helpers; + with System; use type System.Address; package body Ada.Containers.Hashed_Maps is pragma Annotate (CodePeer, Skip_Analysis); + pragma Warnings (Off, "variable ""Busy*"" is not referenced"); + pragma Warnings (Off, "variable ""Lock*"" is not referenced"); + -- See comment in Ada.Containers.Helpers + ----------------------- -- Local Subprograms -- ----------------------- @@ -123,20 +129,6 @@ package body Ada.Containers.Hashed_Maps is HT_Ops.Adjust (Container.HT); end Adjust; - procedure Adjust (Control : in out Reference_Control_Type) is - begin - if Control.Container /= null then - declare - HT : Hash_Table_Type renames Control.Container.all.HT; - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; - begin - B := B + 1; - L := L + 1; - end; - end if; - end Adjust; - ------------ -- Assign -- ------------ @@ -199,12 +191,13 @@ package body Ada.Containers.Hashed_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; @@ -215,15 +208,14 @@ package body Ada.Containers.Hashed_Maps is declare HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT; - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; + TC : constant Tamper_Counts_Access := + HT.TC'Unrestricted_Access; begin return R : constant Constant_Reference_Type := (Element => Position.Node.Element'Access, - Control => (Controlled with Position.Container)) + Control => (Controlled with TC)) do - B := B + 1; - L := L + 1; + Lock (TC.all); end return; end; end Constant_Reference; @@ -236,20 +228,19 @@ package body Ada.Containers.Hashed_Maps is Node : constant Node_Access := Key_Ops.Find (HT, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "key not in map"; end if; declare - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; + TC : constant Tamper_Counts_Access := + HT.TC'Unrestricted_Access; begin return R : constant Constant_Reference_Type := (Element => Node.Element'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; @@ -280,7 +271,7 @@ package body Ada.Containers.Hashed_Maps is elsif Capacity >= Source.Length then C := Capacity; - else + elsif Checks then raise Capacity_Error with "Requested capacity is less than Source length"; end if; @@ -316,7 +307,7 @@ package body Ada.Containers.Hashed_Maps is begin Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X); - if X = null then + if Checks and then X = null then raise Constraint_Error with "attempt to delete key not in map"; end if; @@ -325,20 +316,18 @@ package body Ada.Containers.Hashed_Maps is procedure Delete (Container : in out Map; 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.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; - if Container.HT.Busy > 0 then - raise Program_Error with - "Delete attempted to tamper with cursors (map is busy)"; - end if; + TC_Check (Container.HT.TC); pragma Assert (Vet (Position), "bad cursor in Delete"); @@ -357,7 +346,7 @@ package body Ada.Containers.Hashed_Maps is Node : constant Node_Access := Key_Ops.Find (HT, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "no element available because key not in map"; end if; @@ -367,7 +356,7 @@ package body Ada.Containers.Hashed_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; @@ -395,12 +384,12 @@ package body Ada.Containers.Hashed_Maps is function Equivalent_Keys (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 Equivalent_Keys 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 Equivalent_Keys equals No_Element"; end if; @@ -413,7 +402,7 @@ package body Ada.Containers.Hashed_Maps is function Equivalent_Keys (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 Equivalent_Keys equals No_Element"; end if; @@ -425,7 +414,7 @@ package body Ada.Containers.Hashed_Maps is function Equivalent_Keys (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 Equivalent_Keys equals No_Element"; end if; @@ -458,27 +447,7 @@ package body Ada.Containers.Hashed_Maps is procedure Finalize (Object : in out Iterator) is begin if Object.Container /= null then - declare - B : Natural renames Object.Container.all.HT.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 - HT : Hash_Table_Type renames Control.Container.all.HT; - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; - begin - B := B - 1; - L := L - 1; - end; - - Control.Container := null; + Unbusy (Object.Container.HT.TC); end if; end Finalize; @@ -600,10 +569,7 @@ package body Ada.Containers.Hashed_Maps is Insert (Container, Key, New_Item, Position, Inserted); if not Inserted then - if Container.HT.Lock > 0 then - raise Program_Error with - "Include attempted to tamper with elements (map is locked)"; - end if; + TE_Check (Container.HT.TC); Position.Node.Key := Key; Position.Node.Element := New_Item; @@ -712,7 +678,7 @@ package body Ada.Containers.Hashed_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 "attempt to insert key already in map"; end if; @@ -749,33 +715,22 @@ package body Ada.Containers.Hashed_Maps is Process (Cursor'(Container'Unrestricted_Access, Node)); end Process_Node; - B : Natural renames Container'Unrestricted_Access.all.HT.Busy; + Busy : With_Busy (Container.HT.TC'Unrestricted_Access); -- Start of processing for Iterate begin - B := B + 1; - - begin - Local_Iterate (Container.HT); - exception - when others => - B := B - 1; - raise; - end; - - B := B - 1; + Local_Iterate (Container.HT); end Iterate; function Iterate (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class is - B : Natural renames Container'Unrestricted_Access.all.HT.Busy; begin return It : constant Iterator := (Limited_Controlled with Container => Container'Unrestricted_Access) do - B := B + 1; + Busy (Container.HT.TC'Unrestricted_Access.all); end return; end Iterate; @@ -785,7 +740,7 @@ package body Ada.Containers.Hashed_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; @@ -860,7 +815,7 @@ package body Ada.Containers.Hashed_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; @@ -875,15 +830,11 @@ package body Ada.Containers.Hashed_Maps is function Pseudo_Reference (Container : aliased Map'Class) return Reference_Control_Type is - C : constant Map_Access := Container'Unrestricted_Access; - B : Natural renames C.HT.Busy; - L : Natural renames C.HT.Lock; + TC : constant Tamper_Counts_Access := + Container.HT.TC'Unrestricted_Access; begin - return R : constant Reference_Control_Type := - (Controlled with C) - do - B := B + 1; - L := L + 1; + return R : constant Reference_Control_Type := (Controlled with TC) do + Lock (TC.all); end return; end Pseudo_Reference; @@ -897,7 +848,7 @@ package body Ada.Containers.Hashed_Maps is procedure (Key : Key_Type; 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; @@ -907,28 +858,11 @@ package body Ada.Containers.Hashed_Maps is declare M : Map renames Position.Container.all; HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; - - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; - + Lock : With_Lock (HT.TC'Unrestricted_Access); + K : Key_Type renames Position.Node.Key; + E : Element_Type renames Position.Node.Element; begin - B := B + 1; - L := L + 1; - - declare - K : Key_Type renames Position.Node.Key; - E : Element_Type renames Position.Node.Element; - 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; @@ -977,12 +911,13 @@ package body Ada.Containers.Hashed_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; @@ -993,15 +928,14 @@ package body Ada.Containers.Hashed_Maps is declare HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT; - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; + TC : constant Tamper_Counts_Access := + HT.TC'Unrestricted_Access; begin return R : constant Reference_Type := (Element => Position.Node.Element'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; @@ -1014,20 +948,19 @@ package body Ada.Containers.Hashed_Maps is Node : constant Node_Access := Key_Ops.Find (HT, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "key not in map"; end if; declare - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; + TC : constant Tamper_Counts_Access := + HT.TC'Unrestricted_Access; begin return R : constant Reference_Type := (Element => Node.Element'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; @@ -1064,15 +997,12 @@ package body Ada.Containers.Hashed_Maps is Node : constant Node_Access := Key_Ops.Find (Container.HT, Key); begin - if Node = null then + if Checks and then Node = null then raise Constraint_Error with "attempt to replace key not in map"; end if; - if Container.HT.Lock > 0 then - raise Program_Error with - "Replace attempted to tamper with elements (map is locked)"; - end if; + TE_Check (Container.HT.TC); Node.Key := Key; Node.Element := New_Item; @@ -1088,20 +1018,18 @@ package body Ada.Containers.Hashed_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.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 Position.Container.HT.Lock > 0 then - raise Program_Error with - "Replace_Element attempted to tamper with elements (map is locked)"; - end if; + TE_Check (Position.Container.HT.TC); pragma Assert (Vet (Position), "bad cursor in Replace_Element"); @@ -1140,12 +1068,13 @@ package body Ada.Containers.Hashed_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.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; @@ -1154,27 +1083,11 @@ package body Ada.Containers.Hashed_Maps is declare HT : Hash_Table_Type renames Container.HT; - B : Natural renames HT.Busy; - L : Natural renames HT.Lock; - + Lock : With_Lock (HT.TC'Unrestricted_Access); + K : Key_Type renames Position.Node.Key; + E : Element_Type renames Position.Node.Element; begin - B := B + 1; - L := L + 1; - - declare - K : Key_Type renames Position.Node.Key; - E : Element_Type renames Position.Node.Element; - 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; |