| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT LIBRARY COMPONENTS -- |
| -- -- |
| -- A D A . C O N T A I N E R S . H E L P E R S -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- Copyright (C) 2015-2022, 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- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Finalization; |
| with System.Atomic_Counters; |
| |
| package Ada.Containers.Helpers is |
| pragma Annotate (CodePeer, Skip_Analysis); |
| pragma Pure; |
| |
| -- Miscellaneous helpers shared among various containers |
| |
| package SAC renames System.Atomic_Counters; |
| |
| Count_Type_Last : constant := Count_Type'Last; |
| -- Count_Type'Last as a universal_integer, so we can compare Index_Type |
| -- values against this without type conversions that might overflow. |
| |
| type Tamper_Counts is record |
| Busy : aliased SAC.Atomic_Unsigned := 0; |
| Lock : aliased SAC.Atomic_Unsigned := 0; |
| end record; |
| |
| -- Busy is positive when tampering with cursors is prohibited. Busy and |
| -- Lock are both positive when tampering with elements is prohibited. |
| |
| type Tamper_Counts_Access is access all Tamper_Counts; |
| for Tamper_Counts_Access'Storage_Size use 0; |
| |
| generic |
| package Generic_Implementation is |
| |
| -- Generic package used in the implementation of containers. |
| |
| -- This needs to be generic so that the 'Enabled attribute will return |
| -- the value that is relevant at the point where a container generic is |
| -- instantiated. For example: |
| -- |
| -- pragma Suppress (Container_Checks); |
| -- package My_Vectors is new Ada.Containers.Vectors (...); |
| -- |
| -- should suppress all container-related checks within the instance |
| -- My_Vectors. |
| |
| -- Shorthands for "checks enabled" and "tampering checks enabled". Note |
| -- that suppressing either Container_Checks or Tampering_Check disables |
| -- tampering checks. Note that this code needs to be in a generic |
| -- package, because we want to take account of check suppressions at the |
| -- instance. We use these flags, along with pragma Inline, to ensure |
| -- that the compiler can optimize away the checks, as well as the |
| -- tampering check machinery, when checks are suppressed. |
| |
| Checks : constant Boolean := Container_Checks'Enabled; |
| T_Check : constant Boolean := |
| Container_Checks'Enabled and Tampering_Check'Enabled; |
| |
| -- Reference_Control_Type is used as a component of reference types, to |
| -- prohibit tampering with elements so long as references exist. |
| |
| type Reference_Control_Type is |
| new Finalization.Controlled with record |
| T_Counts : Tamper_Counts_Access; |
| end record |
| with Disable_Controlled => not T_Check; |
| |
| overriding procedure Adjust (Control : in out Reference_Control_Type); |
| pragma Inline (Adjust); |
| |
| overriding procedure Finalize (Control : in out Reference_Control_Type); |
| pragma Inline (Finalize); |
| |
| procedure Zero_Counts (T_Counts : out Tamper_Counts); |
| pragma Inline (Zero_Counts); |
| -- Set Busy and Lock to zero |
| |
| procedure Busy (T_Counts : in out Tamper_Counts); |
| pragma Inline (Busy); |
| -- Prohibit tampering with cursors |
| |
| procedure Unbusy (T_Counts : in out Tamper_Counts); |
| pragma Inline (Unbusy); |
| -- Allow tampering with cursors |
| |
| procedure Lock (T_Counts : in out Tamper_Counts); |
| pragma Inline (Lock); |
| -- Prohibit tampering with elements |
| |
| procedure Unlock (T_Counts : in out Tamper_Counts); |
| pragma Inline (Unlock); |
| -- Allow tampering with elements |
| |
| procedure TC_Check (T_Counts : Tamper_Counts); |
| pragma Inline (TC_Check); |
| -- Tampering-with-cursors check |
| |
| procedure TE_Check (T_Counts : Tamper_Counts); |
| pragma Inline (TE_Check); |
| -- Tampering-with-elements check |
| |
| ----------------- |
| -- RAII Types -- |
| ----------------- |
| |
| -- Initialize of With_Busy increments the Busy count, and Finalize |
| -- decrements it. Thus, to prohibit tampering with elements within a |
| -- given scope, declare an object of type With_Busy. The Busy count |
| -- will be correctly decremented in case of exception or abort. |
| |
| -- With_Lock is the same as With_Busy, except it increments/decrements |
| -- BOTH Busy and Lock, thus prohibiting tampering with cursors. |
| |
| type With_Busy (T_Counts : not null access Tamper_Counts) is |
| new Finalization.Limited_Controlled with null record |
| with Disable_Controlled => not T_Check; |
| overriding procedure Initialize (Busy : in out With_Busy); |
| overriding procedure Finalize (Busy : in out With_Busy); |
| |
| type With_Lock (T_Counts : not null access Tamper_Counts) is |
| new Finalization.Limited_Controlled with null record |
| with Disable_Controlled => not T_Check; |
| overriding procedure Initialize (Lock : in out With_Lock); |
| overriding procedure Finalize (Lock : in out With_Lock); |
| |
| -- Variables of type With_Busy and With_Lock are declared only for the |
| -- effects of Initialize and Finalize, so they are not referenced; |
| -- disable warnings about that. Note that all variables of these types |
| -- have names starting with "Busy" or "Lock". These pragmas need to be |
| -- present wherever these types are used. |
| |
| pragma Warnings (Off, "variable ""Busy*"" is not referenced"); |
| pragma Warnings (Off, "variable ""Lock*"" is not referenced"); |
| |
| end Generic_Implementation; |
| |
| end Ada.Containers.Helpers; |
