1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_HASHED_MAPS --
9 -- Copyright (C) 2004-2013, 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/>. --
27 -- This unit was originally developed by Matthew J Heaney. --
28 ------------------------------------------------------------------------------
30 with Ada
.Containers
.Hash_Tables
.Generic_Operations
;
31 pragma Elaborate_All
(Ada
.Containers
.Hash_Tables
.Generic_Operations
);
33 with Ada
.Containers
.Hash_Tables
.Generic_Keys
;
34 pragma Elaborate_All
(Ada
.Containers
.Hash_Tables
.Generic_Keys
);
36 with Ada
.Unchecked_Deallocation
;
38 with System
; use type System
.Address
;
40 package body Ada
.Containers
.Indefinite_Hashed_Maps
is
43 new Ada
.Unchecked_Deallocation
(Key_Type
, Key_Access
);
45 procedure Free_Element
is
46 new Ada
.Unchecked_Deallocation
(Element_Type
, Element_Access
);
48 -----------------------
49 -- Local Subprograms --
50 -----------------------
52 function Copy_Node
(Node
: Node_Access
) return Node_Access
;
53 pragma Inline
(Copy_Node
);
55 function Equivalent_Key_Node
57 Node
: Node_Access
) return Boolean;
58 pragma Inline
(Equivalent_Key_Node
);
60 function Find_Equal_Key
61 (R_HT
: Hash_Table_Type
;
62 L_Node
: Node_Access
) return Boolean;
64 procedure Free
(X
: in out Node_Access
);
65 -- pragma Inline (Free);
67 function Hash_Node
(Node
: Node_Access
) return Hash_Type
;
68 pragma Inline
(Hash_Node
);
70 function Next
(Node
: Node_Access
) return Node_Access
;
74 (Stream
: not null access Root_Stream_Type
'Class) return Node_Access
;
76 procedure Set_Next
(Node
: Node_Access
; Next
: Node_Access
);
77 pragma Inline
(Set_Next
);
79 function Vet
(Position
: Cursor
) return Boolean;
82 (Stream
: not null access Root_Stream_Type
'Class;
85 --------------------------
86 -- Local Instantiations --
87 --------------------------
89 package HT_Ops
is new Ada
.Containers
.Hash_Tables
.Generic_Operations
90 (HT_Types
=> HT_Types
,
91 Hash_Node
=> Hash_Node
,
94 Copy_Node
=> Copy_Node
,
97 package Key_Ops
is new Hash_Tables
.Generic_Keys
98 (HT_Types
=> HT_Types
,
100 Set_Next
=> Set_Next
,
101 Key_Type
=> Key_Type
,
103 Equivalent_Keys
=> Equivalent_Key_Node
);
109 function Is_Equal
is new HT_Ops
.Generic_Equal
(Find_Equal_Key
);
111 overriding
function "=" (Left
, Right
: Map
) return Boolean is
113 return Is_Equal
(Left
.HT
, Right
.HT
);
120 procedure Adjust
(Container
: in out Map
) is
122 HT_Ops
.Adjust
(Container
.HT
);
125 procedure Adjust
(Control
: in out Reference_Control_Type
) is
127 if Control
.Container
/= null then
129 M
: Map
renames Control
.Container
.all;
130 HT
: Hash_Table_Type
renames M
.HT
'Unrestricted_Access.all;
131 B
: Natural renames HT
.Busy
;
132 L
: Natural renames HT
.Lock
;
144 procedure Assign
(Target
: in out Map
; Source
: Map
) is
145 procedure Insert_Item
(Node
: Node_Access
);
146 pragma Inline
(Insert_Item
);
148 procedure Insert_Items
is new HT_Ops
.Generic_Iteration
(Insert_Item
);
154 procedure Insert_Item
(Node
: Node_Access
) is
156 Target
.Insert
(Key
=> Node
.Key
.all, New_Item
=> Node
.Element
.all);
159 -- Start of processing for Assign
162 if Target
'Address = Source
'Address then
168 if Target
.Capacity
< Source
.Length
then
169 Target
.Reserve_Capacity
(Source
.Length
);
172 Insert_Items
(Target
.HT
);
179 function Capacity
(Container
: Map
) return Count_Type
is
181 return HT_Ops
.Capacity
(Container
.HT
);
188 procedure Clear
(Container
: in out Map
) is
190 HT_Ops
.Clear
(Container
.HT
);
193 ------------------------
194 -- Constant_Reference --
195 ------------------------
197 function Constant_Reference
198 (Container
: aliased Map
;
199 Position
: Cursor
) return Constant_Reference_Type
202 if Position
.Container
= null then
203 raise Constraint_Error
with
204 "Position cursor has no element";
207 if Position
.Container
/= Container
'Unrestricted_Access then
208 raise Program_Error
with
209 "Position cursor designates wrong map";
212 if Position
.Node
.Element
= null then
213 raise Program_Error
with
214 "Position cursor has no element";
219 "Position cursor in Constant_Reference is bad");
222 M
: Map
renames Position
.Container
.all;
223 HT
: Hash_Table_Type
renames M
.HT
'Unrestricted_Access.all;
224 B
: Natural renames HT
.Busy
;
225 L
: Natural renames HT
.Lock
;
227 return R
: constant Constant_Reference_Type
:=
228 (Element
=> Position
.Node
.Element
.all'Access,
229 Control
=> (Controlled
with Container
'Unrestricted_Access))
235 end Constant_Reference
;
237 function Constant_Reference
238 (Container
: aliased Map
;
239 Key
: Key_Type
) return Constant_Reference_Type
241 Node
: constant Node_Access
:= Key_Ops
.Find
(Container
.HT
, Key
);
245 raise Constraint_Error
with "key not in map";
248 if Node
.Element
= null then
249 raise Program_Error
with "key has no element";
253 M
: Map
renames Container
'Unrestricted_Access.all;
254 HT
: Hash_Table_Type
renames M
.HT
'Unrestricted_Access.all;
255 B
: Natural renames HT
.Busy
;
256 L
: Natural renames HT
.Lock
;
258 return R
: constant Constant_Reference_Type
:=
259 (Element
=> Node
.Element
.all'Access,
260 Control
=> (Controlled
with Container
'Unrestricted_Access))
266 end Constant_Reference
;
272 function Contains
(Container
: Map
; Key
: Key_Type
) return Boolean is
274 return Find
(Container
, Key
) /= No_Element
;
283 Capacity
: Count_Type
:= 0) return Map
291 elsif Capacity
>= Source
.Length
then
296 with "Requested capacity is less than Source length";
299 return Target
: Map
do
300 Target
.Reserve_Capacity
(C
);
301 Target
.Assign
(Source
);
309 function Copy_Node
(Node
: Node_Access
) return Node_Access
is
310 K
: Key_Access
:= new Key_Type
'(Node.Key.all);
314 E := new Element_Type'(Node
.Element
.all);
315 return new Node_Type
'(K, E, null);
328 procedure Delete (Container : in out Map; Key : Key_Type) is
332 Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
335 raise Constraint_Error with "attempt to delete key not in map";
341 procedure Delete (Container : in out Map; Position : in out Cursor) is
343 if Position.Node = null then
344 raise Constraint_Error with
345 "Position cursor of Delete equals No_Element";
348 if Position.Container /= Container'Unrestricted_Access then
349 raise Program_Error with
350 "Position cursor of Delete designates wrong map";
353 if Container.HT.Busy > 0 then
354 raise Program_Error with
355 "Delete attempted to tamper with cursors (map is busy)";
358 pragma Assert (Vet (Position), "bad cursor in Delete");
360 HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
362 Free (Position.Node);
363 Position.Container := null;
370 function Element (Container : Map; Key : Key_Type) return Element_Type is
371 Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
375 raise Constraint_Error with
376 "no element available because key not in map";
379 return Node.Element.all;
382 function Element (Position : Cursor) return Element_Type is
384 if Position.Node = null then
385 raise Constraint_Error with
386 "Position cursor of function Element equals No_Element";
389 if Position.Node.Element = null then
390 raise Program_Error with
391 "Position cursor of function Element is bad";
394 pragma Assert (Vet (Position), "bad cursor in function Element");
396 return Position.Node.Element.all;
399 -------------------------
400 -- Equivalent_Key_Node --
401 -------------------------
403 function Equivalent_Key_Node
405 Node : Node_Access) return Boolean
408 return Equivalent_Keys (Key, Node.Key.all);
409 end Equivalent_Key_Node;
411 ---------------------
412 -- Equivalent_Keys --
413 ---------------------
415 function Equivalent_Keys (Left, Right : Cursor) return Boolean is
417 if Left.Node = null then
418 raise Constraint_Error with
419 "Left cursor of Equivalent_Keys equals No_Element";
422 if Right.Node = null then
423 raise Constraint_Error with
424 "Right cursor of Equivalent_Keys equals No_Element";
427 if Left.Node.Key = null then
428 raise Program_Error with
429 "Left cursor of Equivalent_Keys is bad";
432 if Right.Node.Key = null then
433 raise Program_Error with
434 "Right cursor of Equivalent_Keys is bad";
437 pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
438 pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
440 return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all);
443 function Equivalent_Keys
445 Right : Key_Type) return Boolean
448 if Left.Node = null then
449 raise Constraint_Error with
450 "Left cursor of Equivalent_Keys equals No_Element";
453 if Left.Node.Key = null then
454 raise Program_Error with
455 "Left cursor of Equivalent_Keys is bad";
458 pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
460 return Equivalent_Keys (Left.Node.Key.all, Right);
463 function Equivalent_Keys
465 Right : Cursor) return Boolean
468 if Right.Node = null then
469 raise Constraint_Error with
470 "Right cursor of Equivalent_Keys equals No_Element";
473 if Right.Node.Key = null then
474 raise Program_Error with
475 "Right cursor of Equivalent_Keys is bad";
478 pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
480 return Equivalent_Keys (Left, Right.Node.Key.all);
487 procedure Exclude (Container : in out Map; Key : Key_Type) is
490 Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
498 procedure Finalize (Container : in out Map) is
500 HT_Ops.Finalize (Container.HT);
503 procedure Finalize (Object : in out Iterator) is
505 if Object.Container /= null then
507 B : Natural renames Object.Container.all.HT.Busy;
514 procedure Finalize (Control : in out Reference_Control_Type) is
516 if Control.Container /= null then
518 M : Map renames Control.Container.all;
519 HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
520 B : Natural renames HT.Busy;
521 L : Natural renames HT.Lock;
527 Control.Container := null;
535 function Find (Container : Map; Key : Key_Type) return Cursor is
536 Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
543 return Cursor'(Container
'Unrestricted_Access, Node
);
550 function Find_Equal_Key
551 (R_HT
: Hash_Table_Type
;
552 L_Node
: Node_Access
) return Boolean
554 R_Index
: constant Hash_Type
:= Key_Ops
.Index
(R_HT
, L_Node
.Key
.all);
555 R_Node
: Node_Access
:= R_HT
.Buckets
(R_Index
);
558 while R_Node
/= null loop
559 if Equivalent_Keys
(L_Node
.Key
.all, R_Node
.Key
.all) then
560 return L_Node
.Element
.all = R_Node
.Element
.all;
563 R_Node
:= R_Node
.Next
;
573 function First
(Container
: Map
) return Cursor
is
574 Node
: constant Node_Access
:= HT_Ops
.First
(Container
.HT
);
579 return Cursor
'(Container'Unrestricted_Access, Node);
583 function First (Object : Iterator) return Cursor is
585 return Object.Container.First;
592 procedure Free (X : in out Node_Access) is
593 procedure Deallocate is
594 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
601 X.Next := X; -- detect mischief (in Vet)
610 Free_Element (X.Element);
621 Free_Element (X.Element);
637 function Has_Element (Position : Cursor) return Boolean is
639 pragma Assert (Vet (Position), "bad cursor in Has_Element");
640 return Position.Node /= null;
647 function Hash_Node (Node : Node_Access) return Hash_Type is
649 return Hash (Node.Key.all);
657 (Container : in out Map;
659 New_Item : Element_Type)
668 Insert (Container, Key, New_Item, Position, Inserted);
671 if Container.HT.Lock > 0 then
672 raise Program_Error with
673 "Include attempted to tamper with elements (map is locked)";
676 K := Position.Node.Key;
677 E := Position.Node.Element;
679 Position.Node.Key := new Key_Type'(Key
);
682 -- The element allocator may need an accessibility check in the
683 -- case the actual type is class-wide or has access discriminants
684 -- (see RM 4.8(10.1) and AI12-0035).
686 pragma Unsuppress
(Accessibility_Check
);
689 Position
.Node
.Element
:= new Element_Type
'(New_Item);
707 (Container : in out Map;
709 New_Item : Element_Type;
710 Position : out Cursor;
711 Inserted : out Boolean)
713 function New_Node (Next : Node_Access) return Node_Access;
715 procedure Local_Insert is
716 new Key_Ops.Generic_Conditional_Insert (New_Node);
722 function New_Node (Next : Node_Access) return Node_Access is
723 K : Key_Access := new Key_Type'(Key
);
726 -- The element allocator may need an accessibility check in the case
727 -- the actual type is class-wide or has access discriminants (see
728 -- RM 4.8(10.1) and AI12-0035).
730 pragma Unsuppress
(Accessibility_Check
);
733 E
:= new Element_Type
'(New_Item);
734 return new Node_Type'(K
, E
, Next
);
743 HT
: Hash_Table_Type
renames Container
.HT
;
745 -- Start of processing for Insert
748 if HT_Ops
.Capacity
(HT
) = 0 then
749 HT_Ops
.Reserve_Capacity
(HT
, 1);
752 Local_Insert
(HT
, Key
, Position
.Node
, Inserted
);
755 and then HT
.Length
> HT_Ops
.Capacity
(HT
)
757 HT_Ops
.Reserve_Capacity
(HT
, HT
.Length
);
760 Position
.Container
:= Container
'Unchecked_Access;
764 (Container
: in out Map
;
766 New_Item
: Element_Type
)
769 pragma Unreferenced
(Position
);
774 Insert
(Container
, Key
, New_Item
, Position
, Inserted
);
777 raise Constraint_Error
with
778 "attempt to insert key already in map";
786 function Is_Empty
(Container
: Map
) return Boolean is
788 return Container
.HT
.Length
= 0;
797 Process
: not null access procedure (Position
: Cursor
))
799 procedure Process_Node
(Node
: Node_Access
);
800 pragma Inline
(Process_Node
);
802 procedure Local_Iterate
is
803 new HT_Ops
.Generic_Iteration
(Process_Node
);
809 procedure Process_Node
(Node
: Node_Access
) is
811 Process
(Cursor
'(Container'Unrestricted_Access, Node));
814 B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
816 -- Start of processing Iterate
822 Local_Iterate (Container.HT);
833 (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
835 B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
837 return It : constant Iterator :=
838 (Limited_Controlled with Container => Container'Unrestricted_Access)
848 function Key (Position : Cursor) return Key_Type is
850 if Position.Node = null then
851 raise Constraint_Error with
852 "Position cursor of function Key equals No_Element";
855 if Position.Node.Key = null then
856 raise Program_Error with
857 "Position cursor of function Key is bad";
860 pragma Assert (Vet (Position), "bad cursor in function Key");
862 return Position.Node.Key.all;
869 function Length (Container : Map) return Count_Type is
871 return Container.HT.Length;
879 (Target : in out Map;
883 HT_Ops.Move (Target => Target.HT, Source => Source.HT);
890 function Next (Node : Node_Access) return Node_Access is
895 procedure Next (Position : in out Cursor) is
897 Position := Next (Position);
900 function Next (Position : Cursor) return Cursor is
902 if Position.Node = null then
906 if Position.Node.Key = null
907 or else Position.Node.Element = null
909 raise Program_Error with "Position cursor of Next is bad";
912 pragma Assert (Vet (Position), "Position cursor of Next is bad");
915 HT : Hash_Table_Type renames Position.Container.HT;
916 Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
921 return Cursor'(Position
.Container
, Node
);
926 function Next
(Object
: Iterator
; Position
: Cursor
) return Cursor
is
928 if Position
.Container
= null then
932 if Position
.Container
/= Object
.Container
then
933 raise Program_Error
with
934 "Position cursor of Next designates wrong map";
937 return Next
(Position
);
944 procedure Query_Element
946 Process
: not null access procedure (Key
: Key_Type
;
947 Element
: Element_Type
))
950 if Position
.Node
= null then
951 raise Constraint_Error
with
952 "Position cursor of Query_Element equals No_Element";
955 if Position
.Node
.Key
= null
956 or else Position
.Node
.Element
= null
958 raise Program_Error
with
959 "Position cursor of Query_Element is bad";
962 pragma Assert
(Vet
(Position
), "bad cursor in Query_Element");
965 M
: Map
renames Position
.Container
.all;
966 HT
: Hash_Table_Type
renames M
.HT
'Unrestricted_Access.all;
968 B
: Natural renames HT
.Busy
;
969 L
: Natural renames HT
.Lock
;
976 K
: Key_Type
renames Position
.Node
.Key
.all;
977 E
: Element_Type
renames Position
.Node
.Element
.all;
997 procedure Read_Nodes
is new HT_Ops
.Generic_Read
(Read_Node
);
1000 (Stream
: not null access Root_Stream_Type
'Class;
1001 Container
: out Map
)
1004 Read_Nodes
(Stream
, Container
.HT
);
1008 (Stream
: not null access Root_Stream_Type
'Class;
1012 raise Program_Error
with "attempt to stream map cursor";
1016 (Stream
: not null access Root_Stream_Type
'Class;
1017 Item
: out Reference_Type
)
1020 raise Program_Error
with "attempt to stream reference";
1024 (Stream
: not null access Root_Stream_Type
'Class;
1025 Item
: out Constant_Reference_Type
)
1028 raise Program_Error
with "attempt to stream reference";
1036 (Stream
: not null access Root_Stream_Type
'Class) return Node_Access
1038 Node
: Node_Access
:= new Node_Type
;
1042 Node
.Key
:= new Key_Type
'(Key_Type'Input (Stream));
1050 Node.Element := new Element_Type'(Element_Type
'Input (Stream
));
1053 Free_Key
(Node
.Key
);
1066 (Container
: aliased in out Map
;
1067 Position
: Cursor
) return Reference_Type
1070 if Position
.Container
= null then
1071 raise Constraint_Error
with
1072 "Position cursor has no element";
1075 if Position
.Container
/= Container
'Unrestricted_Access then
1076 raise Program_Error
with
1077 "Position cursor designates wrong map";
1080 if Position
.Node
.Element
= null then
1081 raise Program_Error
with
1082 "Position cursor has no element";
1087 "Position cursor in function Reference is bad");
1090 M
: Map
renames Position
.Container
.all;
1091 HT
: Hash_Table_Type
renames M
.HT
'Unrestricted_Access.all;
1092 B
: Natural renames HT
.Busy
;
1093 L
: Natural renames HT
.Lock
;
1095 return R
: constant Reference_Type
:=
1096 (Element
=> Position
.Node
.Element
.all'Access,
1097 Control
=> (Controlled
with Position
.Container
))
1106 (Container
: aliased in out Map
;
1107 Key
: Key_Type
) return Reference_Type
1109 Node
: constant Node_Access
:= Key_Ops
.Find
(Container
.HT
, Key
);
1113 raise Constraint_Error
with "key not in map";
1116 if Node
.Element
= null then
1117 raise Program_Error
with "key has no element";
1121 M
: Map
renames Container
'Unrestricted_Access.all;
1122 HT
: Hash_Table_Type
renames M
.HT
'Unrestricted_Access.all;
1123 B
: Natural renames HT
.Busy
;
1124 L
: Natural renames HT
.Lock
;
1126 return R
: constant Reference_Type
:=
1127 (Element
=> Node
.Element
.all'Access,
1128 Control
=> (Controlled
with Container
'Unrestricted_Access))
1141 (Container
: in out Map
;
1143 New_Item
: Element_Type
)
1145 Node
: constant Node_Access
:= Key_Ops
.Find
(Container
.HT
, Key
);
1152 raise Constraint_Error
with
1153 "attempt to replace key not in map";
1156 if Container
.HT
.Lock
> 0 then
1157 raise Program_Error
with
1158 "Replace attempted to tamper with elements (map is locked)";
1164 Node
.Key
:= new Key_Type
'(Key);
1167 -- The element allocator may need an accessibility check in the case
1168 -- the actual type is class-wide or has access discriminants (see
1169 -- RM 4.8(10.1) and AI12-0035).
1171 pragma Unsuppress (Accessibility_Check);
1174 Node.Element := new Element_Type'(New_Item
);
1186 ---------------------
1187 -- Replace_Element --
1188 ---------------------
1190 procedure Replace_Element
1191 (Container
: in out Map
;
1193 New_Item
: Element_Type
)
1196 if Position
.Node
= null then
1197 raise Constraint_Error
with
1198 "Position cursor of Replace_Element equals No_Element";
1201 if Position
.Node
.Key
= null
1202 or else Position
.Node
.Element
= null
1204 raise Program_Error
with
1205 "Position cursor of Replace_Element is bad";
1208 if Position
.Container
/= Container
'Unrestricted_Access then
1209 raise Program_Error
with
1210 "Position cursor of Replace_Element designates wrong map";
1213 if Position
.Container
.HT
.Lock
> 0 then
1214 raise Program_Error
with
1215 "Replace_Element attempted to tamper with elements (map is locked)";
1218 pragma Assert
(Vet
(Position
), "bad cursor in Replace_Element");
1221 X
: Element_Access
:= Position
.Node
.Element
;
1223 -- The element allocator may need an accessibility check in the case
1224 -- the actual type is class-wide or has access discriminants (see
1225 -- RM 4.8(10.1) and AI12-0035).
1227 pragma Unsuppress
(Accessibility_Check
);
1230 Position
.Node
.Element
:= new Element_Type
'(New_Item);
1233 end Replace_Element;
1235 ----------------------
1236 -- Reserve_Capacity --
1237 ----------------------
1239 procedure Reserve_Capacity
1240 (Container : in out Map;
1241 Capacity : Count_Type)
1244 HT_Ops.Reserve_Capacity (Container.HT, Capacity);
1245 end Reserve_Capacity;
1251 procedure Set_Next (Node : Node_Access; Next : Node_Access) is
1256 --------------------
1257 -- Update_Element --
1258 --------------------
1260 procedure Update_Element
1261 (Container : in out Map;
1263 Process : not null access procedure (Key : Key_Type;
1264 Element : in out Element_Type))
1267 if Position.Node = null then
1268 raise Constraint_Error with
1269 "Position cursor of Update_Element equals No_Element";
1272 if Position.Node.Key = null
1273 or else Position.Node.Element = null
1275 raise Program_Error with
1276 "Position cursor of Update_Element is bad";
1279 if Position.Container /= Container'Unrestricted_Access then
1280 raise Program_Error with
1281 "Position cursor of Update_Element designates wrong map";
1284 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1287 HT : Hash_Table_Type renames Container.HT;
1289 B : Natural renames HT.Busy;
1290 L : Natural renames HT.Lock;
1297 K : Key_Type renames Position.Node.Key.all;
1298 E : Element_Type renames Position.Node.Element.all;
1319 function Vet (Position : Cursor) return Boolean is
1321 if Position.Node = null then
1322 return Position.Container = null;
1325 if Position.Container = null then
1329 if Position.Node.Next = Position.Node then
1333 if Position.Node.Key = null then
1337 if Position.Node.Element = null then
1342 HT : Hash_Table_Type renames Position.Container.HT;
1346 if HT.Length = 0 then
1350 if HT.Buckets = null
1351 or else HT.Buckets'Length = 0
1356 X := HT.Buckets (Key_Ops.Index (HT, Position.Node.Key.all));
1358 for J in 1 .. HT.Length loop
1359 if X = Position.Node then
1367 if X = X.Next then -- to prevent unnecessary looping
1382 procedure Write_Nodes is new HT_Ops.Generic_Write (Write_Node);
1385 (Stream : not null access Root_Stream_Type'Class;
1389 Write_Nodes (Stream, Container.HT);
1393 (Stream : not null access Root_Stream_Type'Class;
1397 raise Program_Error with "attempt to stream map cursor";
1401 (Stream : not null access Root_Stream_Type'Class;
1402 Item : Reference_Type)
1405 raise Program_Error with "attempt to stream reference";
1409 (Stream : not null access Root_Stream_Type'Class;
1410 Item : Constant_Reference_Type)
1413 raise Program_Error with "attempt to stream reference";
1420 procedure Write_Node
1421 (Stream : not null access Root_Stream_Type'Class;
1425 Key_Type'Output (Stream, Node.Key.all);
1426 Element_Type'Output (Stream, Node.Element.all);
1429 end Ada.Containers.Indefinite_Hashed_Maps;