diff options
Diffstat (limited to 'gcc/ada/a-cbmutr.adb')
| -rw-r--r-- | gcc/ada/a-cbmutr.adb | 101 |
1 files changed, 79 insertions, 22 deletions
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb index 7ad2de4e62a..acda30f63c6 100644 --- a/gcc/ada/a-cbmutr.adb +++ b/gcc/ada/a-cbmutr.adb @@ -27,30 +27,38 @@ -- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------ -with System; use type System.Address; +with Ada.Finalization; use Ada.Finalization; +with System; use type System.Address; + package body Ada.Containers.Bounded_Multiway_Trees is No_Node : constant Count_Type'Base := -1; - type Iterator is new Tree_Iterator_Interfaces.Forward_Iterator with + type Iterator is new Limited_Controlled and + Tree_Iterator_Interfaces.Forward_Iterator with record Container : Tree_Access; Position : Cursor; From_Root : Boolean; end record; + overriding procedure Finalize (Object : in out Iterator); + overriding function First (Object : Iterator) return Cursor; overriding function Next (Object : Iterator; Position : Cursor) return Cursor; - type Child_Iterator is new Tree_Iterator_Interfaces.Reversible_Iterator with + type Child_Iterator is new Limited_Controlled and + Tree_Iterator_Interfaces.Reversible_Iterator with record Container : Tree_Access; Position : Cursor; end record; + overriding procedure Finalize (Object : in out Child_Iterator); + overriding function First (Object : Child_Iterator) return Cursor; overriding function Next @@ -1229,6 +1237,34 @@ package body Ada.Containers.Bounded_Multiway_Trees is Right_Subtree => Right_Subtree); end Equal_Subtree; + -------------- + -- Finalize -- + -------------- + + procedure Finalize (Object : in out Iterator) is + begin + if Object.Container /= null then + declare + B : Natural renames Object.Container.all.Busy; + + begin + B := B - 1; + end; + end if; + end Finalize; + + procedure Finalize (Object : in out Child_Iterator) is + begin + if Object.Container /= null then + declare + B : Natural renames Object.Container.all.Busy; + + begin + B := B - 1; + end; + end if; + end Finalize; + ---------- -- Find -- ---------- @@ -1732,8 +1768,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is (Container : Tree; Process : not null access procedure (Position : Cursor)) is - T : Tree renames Container'Unrestricted_Access.all; - B : Integer renames T.Busy; + B : Natural renames Container'Unrestricted_Access.all.Busy; begin if Container.Count = 0 then @@ -1758,13 +1793,19 @@ package body Ada.Containers.Bounded_Multiway_Trees is function Iterate (Container : Tree) return Tree_Iterator_Interfaces.Forward_Iterator'Class is - Root_Cursor : constant Cursor := - (Container'Unrestricted_Access, Root_Node (Container)); + B : Natural renames Container'Unrestricted_Access.all.Busy; + RC : constant Cursor := + (Container'Unrestricted_Access, Root_Node (Container)); + begin - return - Iterator'(Container'Unrestricted_Access, - First_Child (Root_Cursor), - From_Root => True); + return It : constant Iterator := + Iterator'(Limited_Controlled with + Container => Container'Unrestricted_Access, + Position => First_Child (RC), + From_Root => True) + do + B := B + 1; + end return; end Iterate; ---------------------- @@ -1786,9 +1827,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is end if; declare - NN : Tree_Node_Array renames Parent.Container.Nodes; - B : Integer renames Parent.Container.Busy; + B : Natural renames Parent.Container.Busy; C : Count_Type; + NN : Tree_Node_Array renames Parent.Container.Nodes; begin B := B + 1; @@ -1836,9 +1877,16 @@ package body Ada.Containers.Bounded_Multiway_Trees is Parent : Cursor) return Tree_Iterator_Interfaces.Reversible_Iterator'Class is - pragma Unreferenced (Container); + B : Natural renames Container'Unrestricted_Access.all.Busy; + begin - return Child_Iterator'(Parent.Container, Parent); + return It : constant Child_Iterator := + Child_Iterator'(Limited_Controlled with + Container => Parent.Container, + Position => Parent) + do + B := B + 1; + end return; end Iterate_Children; --------------------- @@ -1849,8 +1897,17 @@ package body Ada.Containers.Bounded_Multiway_Trees is (Position : Cursor) return Tree_Iterator_Interfaces.Forward_Iterator'Class is + B : Natural renames Position.Container.all.Busy; + begin - return Iterator'(Position.Container, Position, From_Root => False); + return It : constant Iterator := + Iterator'(Limited_Controlled with + Container => Position.Container, + Position => Position, + From_Root => False) + do + B := B + 1; + end return; end Iterate_Subtree; procedure Iterate_Subtree @@ -1869,7 +1926,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is declare T : Tree renames Position.Container.all; - B : Integer renames T.Busy; + B : Natural renames T.Busy; begin B := B + 1; @@ -2259,8 +2316,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is declare T : Tree renames Position.Container.all'Unrestricted_Access.all; - B : Integer renames T.Busy; - L : Integer renames T.Lock; + B : Natural renames T.Busy; + L : Natural renames T.Lock; begin B := B + 1; @@ -2529,7 +2586,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is declare NN : Tree_Node_Array renames Parent.Container.Nodes; - B : Integer renames Parent.Container.Busy; + B : Natural renames Parent.Container.Busy; C : Count_Type; begin @@ -3209,8 +3266,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is declare T : Tree renames Position.Container.all'Unrestricted_Access.all; - B : Integer renames T.Busy; - L : Integer renames T.Lock; + B : Natural renames T.Busy; + L : Natural renames T.Lock; begin B := B + 1; |