gcc/ada/a-cfhama.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --    A D A . C O N T A I N E R S . F O R M A L _ H A S H E D _ M A P S     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2010-2013, Free Software Foundation, Inc.         --
  10 --                                                                          --
  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.                                     --
  17 --                                                                          --
  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.               --
  21 --                                                                          --
  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 ------------------------------------------------------------------------------
  27
  28 with Ada.Containers.Hash_Tables.Generic_Bounded_Operations;
  29 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Operations);
  30
  31 with Ada.Containers.Hash_Tables.Generic_Bounded_Keys;
  32 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys);
  33
  34 with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
  35
  36 with System;  use type System.Address;
  37
  38 package body Ada.Containers.Formal_Hashed_Maps is
  39
  40    -----------------------
  41    -- Local Subprograms --
  42    -----------------------
  43
  44    --  All local subprograms require comments ???
  45
  46    function Equivalent_Keys
  47      (Key  : Key_Type;
  48       Node : Node_Type) return Boolean;
  49    pragma Inline (Equivalent_Keys);
  50
  51    procedure Free
  52      (HT : in out Map;
  53       X  : Count_Type);
  54
  55    generic
  56       with procedure Set_Element (Node : in out Node_Type);
  57    procedure Generic_Allocate
  58      (HT   : in out Map;
  59       Node : out Count_Type);
  60
  61    function Hash_Node (Node : Node_Type) return Hash_Type;
  62    pragma Inline (Hash_Node);
  63
  64    function Next (Node : Node_Type) return Count_Type;
  65    pragma Inline (Next);
  66
  67    procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
  68    pragma Inline (Set_Next);
  69
  70    function Vet (Container : Map; Position : Cursor) return Boolean;
  71
  72    --------------------------
  73    -- Local Instantiations --
  74    --------------------------
  75
  76    package HT_Ops is
  77      new Hash_Tables.Generic_Bounded_Operations
  78        (HT_Types  => HT_Types,
  79         Hash_Node => Hash_Node,
  80         Next      => Next,
  81         Set_Next  => Set_Next);
  82
  83    package Key_Ops is
  84      new Hash_Tables.Generic_Bounded_Keys
  85        (HT_Types        => HT_Types,
  86         Next            => Next,
  87         Set_Next        => Set_Next,
  88         Key_Type        => Key_Type,
  89         Hash            => Hash,
  90         Equivalent_Keys => Equivalent_Keys);
  91
  92    ---------
  93    -- "=" --
  94    ---------
  95
  96    function "=" (Left, Right : Map) return Boolean is
  97    begin
  98       if Length (Left) /= Length (Right) then
  99          return False;
 100       end if;
 101
 102       if Length (Left) = 0 then
 103          return True;
 104       end if;
 105
 106       declare
 107          Node  : Count_Type;
 108          ENode : Count_Type;
 109
 110       begin
 111          Node := Left.First.Node;
 112          while Node /= 0 loop
 113             ENode := Find (Container => Right,
 114                            Key       => Left.Nodes (Node).Key).Node;
 115
 116             if ENode = 0 or else
 117               Right.Nodes (ENode).Element /= Left.Nodes (Node).Element
 118             then
 119                return False;
 120             end if;
 121
 122             Node := HT_Ops.Next (Left, Node);
 123          end loop;
 124
 125          return True;
 126       end;
 127    end "=";
 128
 129    ------------
 130    -- Assign --
 131    ------------
 132
 133    procedure Assign (Target : in out Map; Source : Map) is
 134       procedure Insert_Element (Source_Node : Count_Type);
 135       pragma Inline (Insert_Element);
 136
 137       procedure Insert_Elements is
 138         new HT_Ops.Generic_Iteration (Insert_Element);
 139
 140       --------------------
 141       -- Insert_Element --
 142       --------------------
 143
 144       procedure Insert_Element (Source_Node : Count_Type) is
 145          N : Node_Type renames Source.Nodes (Source_Node);
 146       begin
 147          Target.Insert (N.Key, N.Element);
 148       end Insert_Element;
 149
 150       --  Start of processing for Assign
 151
 152    begin
 153       if Target'Address = Source'Address then
 154          return;
 155       end if;
 156
 157       if Target.Capacity < Length (Source) then
 158          raise Constraint_Error with  -- correct exception ???
 159            "Source length exceeds Target capacity";
 160       end if;
 161
 162       Clear (Target);
 163
 164       Insert_Elements (Source);
 165    end Assign;
 166
 167    --------------
 168    -- Capacity --
 169    --------------
 170
 171    function Capacity (Container : Map) return Count_Type is
 172    begin
 173       return Container.Nodes'Length;
 174    end Capacity;
 175
 176    -----------
 177    -- Clear --
 178    -----------
 179
 180    procedure Clear (Container : in out Map) is
 181    begin
 182       HT_Ops.Clear (Container);
 183    end Clear;
 184
 185    --------------
 186    -- Contains --
 187    --------------
 188
 189    function Contains (Container : Map; Key : Key_Type) return Boolean is
 190    begin
 191       return Find (Container, Key) /= No_Element;
 192    end Contains;
 193
 194    ----------
 195    -- Copy --
 196    ----------
 197
 198    function Copy
 199      (Source   : Map;
 200       Capacity : Count_Type := 0) return Map
 201    is
 202       C      : constant Count_Type :=
 203         Count_Type'Max (Capacity, Source.Capacity);
 204       H      : Hash_Type;
 205       N      : Count_Type;
 206       Target : Map (C, Source.Modulus);
 207       Cu     : Cursor;
 208
 209    begin
 210       Target.Length := Source.Length;
 211       Target.Free := Source.Free;
 212
 213       H := 1;
 214       while H <= Source.Modulus loop
 215          Target.Buckets (H) := Source.Buckets (H);
 216          H := H + 1;
 217       end loop;
 218
 219       N := 1;
 220       while N <= Source.Capacity loop
 221          Target.Nodes (N) := Source.Nodes (N);
 222          N := N + 1;
 223       end loop;
 224
 225       while N <= C loop
 226          Cu := (Node => N);
 227          Free (Target, Cu.Node);
 228          N := N + 1;
 229       end loop;
 230
 231       return Target;
 232    end Copy;
 233
 234    ---------------------
 235    -- Default_Modulus --
 236    ---------------------
 237
 238    function Default_Modulus (Capacity : Count_Type) return Hash_Type is
 239    begin
 240       return To_Prime (Capacity);
 241    end Default_Modulus;
 242
 243    ------------
 244    -- Delete --
 245    ------------
 246
 247    procedure Delete (Container : in out Map; Key : Key_Type) is
 248       X : Count_Type;
 249
 250    begin
 251       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
 252
 253       if X = 0 then
 254          raise Constraint_Error with "attempt to delete key not in map";
 255       end if;
 256
 257       Free (Container, X);
 258    end Delete;
 259
 260    procedure Delete (Container : in out Map; Position : in out Cursor) is
 261    begin
 262       if not Has_Element (Container, Position) then
 263          raise Constraint_Error with
 264            "Position cursor of Delete has no element";
 265       end if;
 266
 267       pragma Assert (Vet (Container, Position), "bad cursor in Delete");
 268
 269       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
 270
 271       Free (Container, Position.Node);
 272    end Delete;
 273
 274    -------------
 275    -- Element --
 276    -------------
 277
 278    function Element (Container : Map; Key : Key_Type) return Element_Type is
 279       Node : constant Count_Type := Find (Container, Key).Node;
 280
 281    begin
 282       if Node = 0 then
 283          raise Constraint_Error with
 284            "no element available because key not in map";
 285       end if;
 286
 287       return Container.Nodes (Node).Element;
 288    end Element;
 289
 290    function Element (Container : Map; Position : Cursor) return Element_Type is
 291    begin
 292       if not Has_Element (Container, Position) then
 293          raise Constraint_Error with "Position cursor equals No_Element";
 294       end if;
 295
 296       pragma Assert (Vet (Container, Position),
 297                      "bad cursor in function Element");
 298
 299       return Container.Nodes (Position.Node).Element;
 300    end Element;
 301
 302    ---------------------
 303    -- Equivalent_Keys --
 304    ---------------------
 305
 306    function Equivalent_Keys
 307      (Key  : Key_Type;
 308       Node : Node_Type) return Boolean
 309    is
 310    begin
 311       return Equivalent_Keys (Key, Node.Key);
 312    end Equivalent_Keys;
 313
 314    function Equivalent_Keys
 315      (Left   : Map;
 316       CLeft  : Cursor;
 317       Right  : Map;
 318       CRight : Cursor) return Boolean
 319    is
 320    begin
 321       if not Has_Element (Left, CLeft) then
 322          raise Constraint_Error with
 323            "Left cursor of Equivalent_Keys has no element";
 324       end if;
 325
 326       if not Has_Element (Right, CRight) then
 327          raise Constraint_Error with
 328            "Right cursor of Equivalent_Keys has no element";
 329       end if;
 330
 331       pragma Assert (Vet (Left, CLeft),
 332                      "Left cursor of Equivalent_Keys is bad");
 333       pragma Assert (Vet (Right, CRight),
 334                      "Right cursor of Equivalent_Keys is bad");
 335
 336       declare
 337          LN : Node_Type renames Left.Nodes (CLeft.Node);
 338          RN : Node_Type renames Right.Nodes (CRight.Node);
 339       begin
 340          return Equivalent_Keys (LN.Key, RN.Key);
 341       end;
 342    end Equivalent_Keys;
 343
 344    function Equivalent_Keys
 345      (Left  : Map;
 346       CLeft : Cursor;
 347       Right : Key_Type) return Boolean
 348    is
 349    begin
 350       if not Has_Element (Left, CLeft) then
 351          raise Constraint_Error with
 352            "Left cursor of Equivalent_Keys has no element";
 353       end if;
 354
 355       pragma Assert (Vet (Left, CLeft),
 356                      "Left cursor in Equivalent_Keys is bad");
 357
 358       declare
 359          LN : Node_Type renames Left.Nodes (CLeft.Node);
 360       begin
 361          return Equivalent_Keys (LN.Key, Right);
 362       end;
 363    end Equivalent_Keys;
 364
 365    function Equivalent_Keys
 366      (Left   : Key_Type;
 367       Right  : Map;
 368       CRight : Cursor) return Boolean
 369    is
 370    begin
 371       if Has_Element (Right, CRight) then
 372          raise Constraint_Error with
 373            "Right cursor of Equivalent_Keys has no element";
 374       end if;
 375
 376       pragma Assert (Vet (Right, CRight),
 377                      "Right cursor of Equivalent_Keys is bad");
 378
 379       declare
 380          RN : Node_Type renames Right.Nodes (CRight.Node);
 381
 382       begin
 383          return Equivalent_Keys (Left, RN.Key);
 384       end;
 385    end Equivalent_Keys;
 386
 387    -------------
 388    -- Exclude --
 389    -------------
 390
 391    procedure Exclude (Container : in out Map; Key : Key_Type) is
 392       X : Count_Type;
 393    begin
 394       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
 395       Free (Container, X);
 396    end Exclude;
 397
 398    ----------
 399    -- Find --
 400    ----------
 401
 402    function Find (Container : Map; Key : Key_Type) return Cursor is
 403       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 404
 405    begin
 406       if Node = 0 then
 407          return No_Element;
 408       end if;
 409
 410       return (Node => Node);
 411    end Find;
 412
 413    -----------
 414    -- First --
 415    -----------
 416
 417    function First (Container : Map) return Cursor is
 418       Node : constant Count_Type := HT_Ops.First (Container);
 419
 420    begin
 421       if Node = 0 then
 422          return No_Element;
 423       end if;
 424
 425       return (Node => Node);
 426    end First;
 427
 428    ----------
 429    -- Free --
 430    ----------
 431
 432    procedure Free (HT : in out Map; X : Count_Type) is
 433    begin
 434       HT.Nodes (X).Has_Element := False;
 435       HT_Ops.Free (HT, X);
 436    end Free;
 437
 438    ----------------------
 439    -- Generic_Allocate --
 440    ----------------------
 441
 442    procedure Generic_Allocate (HT : in out Map; Node : out Count_Type) is
 443
 444       procedure Allocate is
 445         new HT_Ops.Generic_Allocate (Set_Element);
 446
 447    begin
 448       Allocate (HT, Node);
 449       HT.Nodes (Node).Has_Element := True;
 450    end Generic_Allocate;
 451
 452    -----------------
 453    -- Has_Element --
 454    -----------------
 455
 456    function Has_Element (Container : Map; Position : Cursor) return Boolean is
 457    begin
 458       if Position.Node = 0 or else
 459         not Container.Nodes (Position.Node).Has_Element then
 460          return False;
 461       end if;
 462
 463       return True;
 464    end Has_Element;
 465
 466    ---------------
 467    -- Hash_Node --
 468    ---------------
 469
 470    function Hash_Node (Node : Node_Type) return Hash_Type is
 471    begin
 472       return Hash (Node.Key);
 473    end Hash_Node;
 474
 475    -------------
 476    -- Include --
 477    -------------
 478
 479    procedure Include
 480      (Container : in out Map;
 481       Key       : Key_Type;
 482       New_Item  : Element_Type)
 483    is
 484       Position : Cursor;
 485       Inserted : Boolean;
 486
 487    begin
 488       Insert (Container, Key, New_Item, Position, Inserted);
 489
 490       if not Inserted then
 491          declare
 492             N : Node_Type renames Container.Nodes (Position.Node);
 493          begin
 494             N.Key := Key;
 495             N.Element := New_Item;
 496          end;
 497       end if;
 498    end Include;
 499
 500    ------------
 501    -- Insert --
 502    ------------
 503
 504    procedure Insert
 505      (Container : in out Map;
 506       Key       : Key_Type;
 507       New_Item  : Element_Type;
 508       Position  : out Cursor;
 509       Inserted  : out Boolean)
 510    is
 511       procedure Assign_Key (Node : in out Node_Type);
 512       pragma Inline (Assign_Key);
 513
 514       function New_Node return Count_Type;
 515       pragma Inline (New_Node);
 516
 517       procedure Local_Insert is
 518         new Key_Ops.Generic_Conditional_Insert (New_Node);
 519
 520       procedure Allocate is
 521         new Generic_Allocate (Assign_Key);
 522
 523       -----------------
 524       --  Assign_Key --
 525       -----------------
 526
 527       procedure Assign_Key (Node : in out Node_Type) is
 528       begin
 529          Node.Key := Key;
 530          Node.Element := New_Item;
 531       end Assign_Key;
 532
 533       --------------
 534       -- New_Node --
 535       --------------
 536
 537       function New_Node return Count_Type is
 538          Result : Count_Type;
 539       begin
 540          Allocate (Container, Result);
 541          return Result;
 542       end New_Node;
 543
 544    --  Start of processing for Insert
 545
 546    begin
 547       Local_Insert (Container, Key, Position.Node, Inserted);
 548    end Insert;
 549
 550    procedure Insert
 551      (Container : in out Map;
 552       Key       : Key_Type;
 553       New_Item  : Element_Type)
 554    is
 555       Position : Cursor;
 556       pragma Unreferenced (Position);
 557
 558       Inserted : Boolean;
 559
 560    begin
 561       Insert (Container, Key, New_Item, Position, Inserted);
 562
 563       if not Inserted then
 564          raise Constraint_Error with
 565            "attempt to insert key already in map";
 566       end if;
 567    end Insert;
 568
 569    --------------
 570    -- Is_Empty --
 571    --------------
 572
 573    function Is_Empty (Container : Map) return Boolean is
 574    begin
 575       return Length (Container) = 0;
 576    end Is_Empty;
 577
 578    ---------
 579    -- Key --
 580    ---------
 581
 582    function Key (Container : Map; Position : Cursor) return Key_Type is
 583    begin
 584       if not Has_Element (Container, Position) then
 585          raise Constraint_Error with
 586            "Position cursor of function Key has no element";
 587       end if;
 588
 589       pragma Assert (Vet (Container, Position), "bad cursor in function Key");
 590
 591       return Container.Nodes (Position.Node).Key;
 592    end Key;
 593
 594    ----------
 595    -- Left --
 596    ----------
 597
 598    function Left (Container : Map; Position : Cursor) return Map is
 599       Curs : Cursor;
 600       C    : Map (Container.Capacity, Container.Modulus) :=
 601         Copy (Container, Container.Capacity);
 602       Node : Count_Type;
 603
 604    begin
 605       Curs := Position;
 606
 607       if Curs = No_Element then
 608          return C;
 609       end if;
 610
 611       if not Has_Element (Container, Curs) then
 612          raise Constraint_Error;
 613       end if;
 614
 615       while Curs.Node /= 0 loop
 616          Node := Curs.Node;
 617          Delete (C, Curs);
 618          Curs := Next (Container, (Node => Node));
 619       end loop;
 620
 621       return C;
 622    end Left;
 623
 624    ------------
 625    -- Length --
 626    ------------
 627
 628    function Length (Container : Map) return Count_Type is
 629    begin
 630       return Container.Length;
 631    end Length;
 632
 633    ----------
 634    -- Move --
 635    ----------
 636
 637    procedure Move
 638      (Target : in out Map;
 639       Source : in out Map)
 640    is
 641       NN   : HT_Types.Nodes_Type renames Source.Nodes;
 642       X, Y : Count_Type;
 643
 644    begin
 645       if Target'Address = Source'Address then
 646          return;
 647       end if;
 648
 649       if Target.Capacity < Length (Source) then
 650          raise Constraint_Error with  -- ???
 651            "Source length exceeds Target capacity";
 652       end if;
 653
 654       Clear (Target);
 655
 656       if Source.Length = 0 then
 657          return;
 658       end if;
 659
 660       X := HT_Ops.First (Source);
 661       while X /= 0 loop
 662          Insert (Target, NN (X).Key, NN (X).Element);  -- optimize???
 663
 664          Y := HT_Ops.Next (Source, X);
 665
 666          HT_Ops.Delete_Node_Sans_Free (Source, X);
 667          Free (Source, X);
 668
 669          X := Y;
 670       end loop;
 671    end Move;
 672
 673    ----------
 674    -- Next --
 675    ----------
 676
 677    function Next (Node : Node_Type) return Count_Type is
 678    begin
 679       return Node.Next;
 680    end Next;
 681
 682    function Next (Container : Map; Position : Cursor) return Cursor is
 683    begin
 684       if Position.Node = 0 then
 685          return No_Element;
 686       end if;
 687
 688       if not Has_Element (Container, Position) then
 689          raise Constraint_Error
 690            with "Position has no element";
 691       end if;
 692
 693       pragma Assert (Vet (Container, Position), "bad cursor in function Next");
 694
 695       declare
 696          Node : constant Count_Type := HT_Ops.Next (Container, Position.Node);
 697
 698       begin
 699          if Node = 0 then
 700             return No_Element;
 701          end if;
 702
 703          return (Node => Node);
 704       end;
 705    end Next;
 706
 707    procedure Next (Container : Map; Position : in out Cursor) is
 708    begin
 709       Position := Next (Container, Position);
 710    end Next;
 711
 712    -------------
 713    -- Overlap --
 714    -------------
 715
 716    function Overlap (Left, Right : Map) return Boolean is
 717       Left_Node  : Count_Type;
 718       Left_Nodes : Nodes_Type renames Left.Nodes;
 719
 720    begin
 721       if Length (Right) = 0 or Length (Left) = 0 then
 722          return False;
 723       end if;
 724
 725       if Left'Address = Right'Address then
 726          return True;
 727       end if;
 728
 729       Left_Node := First (Left).Node;
 730       while Left_Node /= 0 loop
 731          declare
 732             N : Node_Type renames Left_Nodes (Left_Node);
 733             E : Key_Type renames N.Key;
 734          begin
 735             if Find (Right, E).Node /= 0 then
 736                return True;
 737             end if;
 738          end;
 739
 740          Left_Node := HT_Ops.Next (Left, Left_Node);
 741       end loop;
 742
 743       return False;
 744    end Overlap;
 745
 746    -------------
 747    -- Replace --
 748    -------------
 749
 750    procedure Replace
 751      (Container : in out Map;
 752       Key       : Key_Type;
 753       New_Item  : Element_Type)
 754    is
 755       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 756
 757    begin
 758       if Node = 0 then
 759          raise Constraint_Error with
 760            "attempt to replace key not in map";
 761       end if;
 762
 763       declare
 764          N : Node_Type renames Container.Nodes (Node);
 765       begin
 766          N.Key := Key;
 767          N.Element := New_Item;
 768       end;
 769    end Replace;
 770
 771    ---------------------
 772    -- Replace_Element --
 773    ---------------------
 774
 775    procedure Replace_Element
 776      (Container : in out Map;
 777       Position  : Cursor;
 778       New_Item  : Element_Type)
 779    is
 780    begin
 781       if not Has_Element (Container, Position) then
 782          raise Constraint_Error with
 783            "Position cursor of Replace_Element has no element";
 784       end if;
 785
 786       pragma Assert (Vet (Container, Position),
 787                      "bad cursor in Replace_Element");
 788
 789       Container.Nodes (Position.Node).Element := New_Item;
 790    end Replace_Element;
 791
 792    ----------------------
 793    -- Reserve_Capacity --
 794    ----------------------
 795
 796    procedure Reserve_Capacity
 797      (Container : in out Map;
 798       Capacity  : Count_Type)
 799    is
 800    begin
 801       if Capacity > Container.Capacity then
 802          raise Capacity_Error with "requested capacity is too large";
 803       end if;
 804    end Reserve_Capacity;
 805
 806    -----------
 807    -- Right --
 808    -----------
 809
 810    function Right (Container : Map; Position : Cursor) return Map is
 811       Curs : Cursor := First (Container);
 812       C    : Map (Container.Capacity, Container.Modulus) :=
 813         Copy (Container, Container.Capacity);
 814       Node : Count_Type;
 815
 816    begin
 817       if Curs = No_Element then
 818          Clear (C);
 819          return C;
 820       end if;
 821
 822       if Position /= No_Element and not Has_Element (Container, Position) then
 823          raise Constraint_Error;
 824       end if;
 825
 826       while Curs.Node /= Position.Node loop
 827          Node := Curs.Node;
 828          Delete (C, Curs);
 829          Curs := Next (Container, (Node => Node));
 830       end loop;
 831
 832       return C;
 833    end Right;
 834
 835    --------------
 836    -- Set_Next --
 837    --------------
 838
 839    procedure Set_Next (Node : in out Node_Type; Next : Count_Type) is
 840    begin
 841       Node.Next := Next;
 842    end Set_Next;
 843
 844    ------------------
 845    -- Strict_Equal --
 846    ------------------
 847
 848    function Strict_Equal (Left, Right : Map) return Boolean is
 849       CuL : Cursor := First (Left);
 850       CuR : Cursor := First (Right);
 851
 852    begin
 853       if Length (Left) /= Length (Right) then
 854          return False;
 855       end if;
 856
 857       while CuL.Node /= 0 or CuR.Node /= 0 loop
 858          if CuL.Node /= CuR.Node or else
 859            (Left.Nodes (CuL.Node).Element /=
 860               Right.Nodes (CuR.Node).Element or
 861               Left.Nodes (CuL.Node).Key /=
 862               Right.Nodes (CuR.Node).Key) then
 863             return False;
 864          end if;
 865
 866          CuL := Next (Left, CuL);
 867          CuR := Next (Right, CuR);
 868       end loop;
 869
 870       return True;
 871    end Strict_Equal;
 872
 873    ---------
 874    -- Vet --
 875    ---------
 876
 877    function Vet (Container : Map; Position : Cursor) return Boolean is
 878    begin
 879       if Position.Node = 0 then
 880          return True;
 881       end if;
 882
 883       declare
 884          X : Count_Type;
 885
 886       begin
 887          if Container.Length = 0 then
 888             return False;
 889          end if;
 890
 891          if Container.Capacity = 0 then
 892             return False;
 893          end if;
 894
 895          if Container.Buckets'Length = 0 then
 896             return False;
 897          end if;
 898
 899          if Position.Node > Container.Capacity then
 900             return False;
 901          end if;
 902
 903          if Container.Nodes (Position.Node).Next = Position.Node then
 904             return False;
 905          end if;
 906
 907          X := Container.Buckets
 908            (Key_Ops.Index (Container, Container.Nodes (Position.Node).Key));
 909
 910          for J in 1 .. Container.Length loop
 911             if X = Position.Node then
 912                return True;
 913             end if;
 914
 915             if X = 0 then
 916                return False;
 917             end if;
 918
 919             if X = Container.Nodes (X).Next then
 920
 921                --  Prevent unnecessary looping
 922
 923                return False;
 924             end if;
 925
 926             X := Container.Nodes (X).Next;
 927          end loop;
 928
 929          return False;
 930       end;
 931    end Vet;
 932
 933 end Ada.Containers.Formal_Hashed_Maps;