diff options
Diffstat (limited to 'gcc/ada/a-coinve.adb')
| -rw-r--r-- | gcc/ada/a-coinve.adb | 97 |
1 files changed, 90 insertions, 7 deletions
diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 326524cc2f1..0627af1b94e 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -578,6 +578,20 @@ package body Ada.Containers.Indefinite_Vectors is end; end Adjust; + procedure Adjust (Control : in out Reference_Control_Type) is + begin + if Control.Container /= null then + declare + C : Vector renames Control.Container.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin + B := B + 1; + L := L + 1; + end; + end if; + end Adjust; + ------------ -- Append -- ------------ @@ -697,7 +711,20 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "element at Position is empty"; end if; - return (Element => E.all'Access); + declare + C : Vector renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin + return R : constant Constant_Reference_Type := + (Element => E.all'Access, + Control => + (Controlled with Container'Unrestricted_Access)) + do + B := B + 1; + L := L + 1; + end return; + end; end Constant_Reference; function Constant_Reference @@ -717,7 +744,20 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "element at Index is empty"; end if; - return (Element => E.all'Access); + declare + C : Vector renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin + return R : constant Constant_Reference_Type := + (Element => E.all'Access, + Control => + (Controlled with Container'Unrestricted_Access)) + do + B := B + 1; + L := L + 1; + end return; + end; end Constant_Reference; -------------- @@ -1131,6 +1171,22 @@ package body Ada.Containers.Indefinite_Vectors is B := B - 1; end Finalize; + procedure Finalize (Control : in out Reference_Control_Type) is + begin + if Control.Container /= null then + declare + C : Vector renames Control.Container.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin + B := B - 1; + L := L - 1; + end; + + Control.Container := null; + end if; + end Finalize; + ---------- -- Find -- ---------- @@ -1402,6 +1458,8 @@ package body Ada.Containers.Indefinite_Vectors is Array_Type => Elements_Array, "<" => Is_Less); + -- Start of processing for Sort + begin if Container.Last <= Index_Type'First then return; @@ -3047,7 +3105,19 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "element at Position is empty"; end if; - return (Element => E.all'Access); + declare + C : Vector renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin + return R : constant Reference_Type := + (Element => E.all'Access, + Control => (Controlled with Position.Container)) + do + B := B + 1; + L := L + 1; + end return; + end; end Reference; function Reference @@ -3067,7 +3137,20 @@ package body Ada.Containers.Indefinite_Vectors is raise Constraint_Error with "element at Index is empty"; end if; - return (Element => E.all'Access); + declare + C : Vector renames Container'Unrestricted_Access.all; + B : Natural renames C.Busy; + L : Natural renames C.Lock; + begin + return R : constant Reference_Type := + (Element => E.all'Access, + Control => + (Controlled with Container'Unrestricted_Access)) + do + B := B + 1; + L := L + 1; + end return; + end; end Reference; --------------------- @@ -3430,9 +3513,9 @@ package body Ada.Containers.Indefinite_Vectors is -- catch more things) instead of for element tampering (which will catch -- fewer things). It's true that the elements of this vector container -- could be safely moved around while (say) an iteration is taking place - -- (iteration only increments the busy counter), and so technically - -- all we would need here is a test for element tampering (indicated - -- by the lock counter), that's simply an artifact of our array-based + -- (iteration only increments the busy counter), and so technically all + -- we would need here is a test for element tampering (indicated by the + -- lock counter), that's simply an artifact of our array-based -- implementation. Logically Reverse_Elements requires a check for -- cursor tampering. |