diff options
Diffstat (limited to 'gcc/ada/a-cihama.adb')
| -rw-r--r-- | gcc/ada/a-cihama.adb | 97 |
1 files changed, 92 insertions, 5 deletions
diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index 3541902..1d30d04 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2012, 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- -- @@ -136,6 +136,21 @@ package body Ada.Containers.Indefinite_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 + M : Map renames Control.Container.all; + HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; + B : Natural renames HT.Busy; + L : Natural renames HT.Lock; + begin + B := B + 1; + L := L + 1; + end; + end if; + end Adjust; + ------------ -- Assign -- ------------ @@ -217,7 +232,21 @@ package body Ada.Containers.Indefinite_Hashed_Maps is (Vet (Position), "Position cursor in Constant_Reference is bad"); - return (Element => Position.Node.Element.all'Access); + 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; + begin + return R : constant Constant_Reference_Type := + (Element => Position.Node.Element.all'Access, + Control => + (Controlled with Container'Unrestricted_Access)) + do + B := B + 1; + L := L + 1; + end return; + end; end Constant_Reference; function Constant_Reference @@ -235,7 +264,21 @@ package body Ada.Containers.Indefinite_Hashed_Maps is raise Program_Error with "key has no element"; end if; - return (Element => Node.Element.all'Access); + declare + M : Map renames Container'Unrestricted_Access.all; + HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; + B : Natural renames HT.Busy; + L : Natural renames HT.Lock; + begin + return R : constant Constant_Reference_Type := + (Element => Node.Element.all'Access, + Control => + (Controlled with Container'Unrestricted_Access)) + do + B := B + 1; + L := L + 1; + end return; + end; end Constant_Reference; -------------- @@ -484,6 +527,23 @@ package body Ada.Containers.Indefinite_Hashed_Maps is end if; end Finalize; + procedure Finalize (Control : in out Reference_Control_Type) is + begin + if Control.Container /= null then + declare + M : Map renames Control.Container.all; + HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; + B : Natural renames HT.Busy; + L : Natural renames HT.Lock; + begin + B := B - 1; + L := L - 1; + end; + + Control.Container := null; + end if; + end Finalize; + ---------- -- Find -- ---------- @@ -1028,7 +1088,20 @@ package body Ada.Containers.Indefinite_Hashed_Maps is (Vet (Position), "Position cursor in function Reference is bad"); - return (Element => Position.Node.Element.all'Access); + 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; + begin + return R : constant Reference_Type := + (Element => Position.Node.Element.all'Access, + Control => (Controlled with Position.Container)) + do + B := B + 1; + L := L + 1; + end return; + end; end Reference; function Reference @@ -1046,7 +1119,21 @@ package body Ada.Containers.Indefinite_Hashed_Maps is raise Program_Error with "key has no element"; end if; - return (Element => Node.Element.all'Access); + declare + M : Map renames Container'Unrestricted_Access.all; + HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; + B : Natural renames HT.Busy; + L : Natural renames HT.Lock; + begin + return R : constant Reference_Type := + (Element => Node.Element.all'Access, + Control => + (Controlled with Container'Unrestricted_Access)) + do + B := B + 1; + L := L + 1; + end return; + end; end Reference; ------------- |