1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . H E L P E R S --
9 -- Copyright (C) 2015, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 ------------------------------------------------------------------------------
28 with Ada
.Finalization
;
29 with System
.Atomic_Counters
;
31 package Ada
.Containers
.Helpers
is
32 pragma Annotate
(CodePeer
, Skip_Analysis
);
35 -- Miscellaneous helpers shared among various containers
37 package SAC
renames System
.Atomic_Counters
;
39 Count_Type_Last
: constant := Count_Type
'Last;
40 -- Count_Type'Last as a universal_integer, so we can compare Index_Type
41 -- values against this without type conversions that might overflow.
43 type Tamper_Counts
is record
44 Busy
: aliased SAC
.Atomic_Unsigned
:= 0;
45 Lock
: aliased SAC
.Atomic_Unsigned
:= 0;
48 -- Busy is positive when tampering with cursors is prohibited. Busy and
49 -- Lock are both positive when tampering with elements is prohibited.
51 type Tamper_Counts_Access
is access all Tamper_Counts
;
52 for Tamper_Counts_Access
'Storage_Size use 0;
55 package Generic_Implementation
is
57 -- Generic package used in the implementation of containers.
58 -- ???????????????????Currently used by Vectors; not yet by all other
61 -- This needs to be generic so that the 'Enabled attribute will return
62 -- the value that is relevant at the point where a container generic is
63 -- instantiated. For example:
65 -- pragma Suppress (Container_Checks);
66 -- package My_Vectors is new Ada.Containers.Vectors (...);
68 -- should suppress all container-related checks within the instance
71 -- Shorthands for "checks enabled" and "tampering checks enabled". Note
72 -- that suppressing either Container_Checks or Tampering_Check disables
73 -- tampering checks. Note that this code needs to be in a generic
74 -- package, because we want to take account of check suppressions at the
75 -- instance. We use these flags, along with pragma Inline, to ensure
76 -- that the compiler can optimize away the checks, as well as the
77 -- tampering check machinery, when checks are suppressed.
79 Checks
: constant Boolean := Container_Checks
'Enabled;
80 T_Check
: constant Boolean :=
81 Container_Checks
'Enabled and Tampering_Check
'Enabled;
83 -- Reference_Control_Type is used as a component of reference types, to
84 -- prohibit tampering with elements so long as references exist.
86 type Reference_Control_Type
is
87 new Finalization
.Controlled
with record
88 T_Counts
: Tamper_Counts_Access
;
90 with Disable_Controlled
=> not T_Check
;
92 overriding
procedure Adjust
(Control
: in out Reference_Control_Type
);
93 pragma Inline
(Adjust
);
95 overriding
procedure Finalize
(Control
: in out Reference_Control_Type
);
96 pragma Inline
(Finalize
);
98 procedure Zero_Counts
(T_Counts
: out Tamper_Counts
);
99 pragma Inline
(Zero_Counts
);
100 -- Set Busy and Lock to zero
102 procedure Busy
(T_Counts
: in out Tamper_Counts
);
103 pragma Inline
(Busy
);
104 -- Prohibit tampering with cursors
106 procedure Unbusy
(T_Counts
: in out Tamper_Counts
);
107 pragma Inline
(Unbusy
);
108 -- Allow tampering with cursors
110 procedure Lock
(T_Counts
: in out Tamper_Counts
);
111 pragma Inline
(Lock
);
112 -- Prohibit tampering with elements
114 procedure Unlock
(T_Counts
: in out Tamper_Counts
);
115 pragma Inline
(Unlock
);
116 -- Allow tampering with elements
118 procedure TC_Check
(T_Counts
: Tamper_Counts
);
119 pragma Inline
(TC_Check
);
120 -- Tampering-with-cursors check
122 procedure TE_Check
(T_Counts
: Tamper_Counts
);
123 pragma Inline
(TE_Check
);
124 -- Tampering-with-elements check
130 -- Initialize of With_Busy increments the Busy count, and Finalize
131 -- decrements it. Thus, to prohibit tampering with elements within a
132 -- given scope, declare an object of type With_Busy. The Busy count
133 -- will be correctly decremented in case of exception or abort.
135 -- With_Lock is the same as With_Busy, except it increments/decrements
136 -- BOTH Busy and Lock, thus prohibiting tampering with cursors.
138 type With_Busy
(T_Counts
: not null access Tamper_Counts
) is
139 new Finalization
.Limited_Controlled
with null record
140 with Disable_Controlled
=> not T_Check
;
141 overriding
procedure Initialize
(Busy
: in out With_Busy
);
142 overriding
procedure Finalize
(Busy
: in out With_Busy
);
144 type With_Lock
(T_Counts
: not null access Tamper_Counts
) is
145 new Finalization
.Limited_Controlled
with null record
146 with Disable_Controlled
=> not T_Check
;
147 overriding
procedure Initialize
(Lock
: in out With_Lock
);
148 overriding
procedure Finalize
(Lock
: in out With_Lock
);
150 -- Variables of type With_Busy and With_Lock are declared only for the
151 -- effects of Initialize and Finalize, so they are not referenced;
152 -- disable warnings about that. Note that all variables of these types
153 -- have names starting with "Busy" or "Lock". These pragmas need to be
154 -- present wherever these types are used.
156 pragma Warnings
(Off
, "variable ""Busy*"" is not referenced");
157 pragma Warnings
(Off
, "variable ""Lock*"" is not referenced");
159 end Generic_Implementation
;
161 end Ada
.Containers
.Helpers
;