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