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
 492          declare
 493             N : Node_Type renames Container.Nodes (Position.Node);
 494          begin
 495             N.Key := Key;
 496             N.Element := New_Item;
 497          end;
 498       end if;
 499    end Include;
 500
 501    ------------
 502    -- Insert --
 503    ------------
 504
 505    procedure Insert
 506      (Container : in out Map;
 507       Key       : Key_Type;
 508       New_Item  : Element_Type;
 509       Position  : out Cursor;
 510       Inserted  : out Boolean)
 511    is
 512       procedure Assign_Key (Node : in out Node_Type);
 513       pragma Inline (Assign_Key);
 514
 515       function New_Node return Count_Type;
 516       pragma Inline (New_Node);
 517
 518       procedure Local_Insert is
 519         new Key_Ops.Generic_Conditional_Insert (New_Node);
 520
 521       procedure Allocate is
 522         new Generic_Allocate (Assign_Key);
 523
 524       -----------------
 525       --  Assign_Key --
 526       -----------------
 527
 528       procedure Assign_Key (Node : in out Node_Type) is
 529       begin
 530          Node.Key := Key;
 531          Node.Element := New_Item;
 532       end Assign_Key;
 533
 534       --------------
 535       -- New_Node --
 536       --------------
 537
 538       function New_Node return Count_Type is
 539          Result : Count_Type;
 540       begin
 541          Allocate (Container, Result);
 542          return Result;
 543       end New_Node;
 544
 545    --  Start of processing for Insert
 546
 547    begin
 548       Local_Insert (Container, Key, Position.Node, Inserted);
 549    end Insert;
 550
 551    procedure Insert
 552      (Container : in out Map;
 553       Key       : Key_Type;
 554       New_Item  : Element_Type)
 555    is
 556       Position : Cursor;
 557       pragma Unreferenced (Position);
 558
 559       Inserted : Boolean;
 560
 561    begin
 562       Insert (Container, Key, New_Item, Position, Inserted);
 563
 564       if not Inserted then
 565          raise Constraint_Error with
 566            "attempt to insert key already in map";
 567       end if;
 568    end Insert;
 569
 570    --------------
 571    -- Is_Empty --
 572    --------------
 573
 574    function Is_Empty (Container : Map) return Boolean is
 575    begin
 576       return Length (Container) = 0;
 577    end Is_Empty;
 578
 579    ---------
 580    -- Key --
 581    ---------
 582
 583    function Key (Container : Map; Position : Cursor) return Key_Type is
 584    begin
 585       if not Has_Element (Container, Position) then
 586          raise Constraint_Error with
 587            "Position cursor of function Key has no element";
 588       end if;
 589
 590       pragma Assert (Vet (Container, Position), "bad cursor in function Key");
 591
 592       return Container.Nodes (Position.Node).Key;
 593    end Key;
 594
 595    ----------
 596    -- Left --
 597    ----------
 598
 599    function Left (Container : Map; Position : Cursor) return Map is
 600       Curs : Cursor;
 601       C    : Map (Container.Capacity, Container.Modulus) :=
 602         Copy (Container, Container.Capacity);
 603       Node : Count_Type;
 604
 605    begin
 606       Curs := Position;
 607
 608       if Curs = No_Element then
 609          return C;
 610       end if;
 611
 612       if not Has_Element (Container, Curs) then
 613          raise Constraint_Error;
 614       end if;
 615
 616       while Curs.Node /= 0 loop
 617          Node := Curs.Node;
 618          Delete (C, Curs);
 619          Curs := Next (Container, (Node => Node));
 620       end loop;
 621
 622       return C;
 623    end Left;
 624
 625    ------------
 626    -- Length --
 627    ------------
 628
 629    function Length (Container : Map) return Count_Type is
 630    begin
 631       return Container.Length;
 632    end Length;
 633
 634    ----------
 635    -- Move --
 636    ----------
 637
 638    procedure Move
 639      (Target : in out Map;
 640       Source : in out Map)
 641    is
 642       NN   : HT_Types.Nodes_Type renames Source.Nodes;
 643       X, Y : Count_Type;
 644
 645    begin
 646       if Target'Address = Source'Address then
 647          return;
 648       end if;
 649
 650       if Target.Capacity < Length (Source) then
 651          raise Constraint_Error with  -- ???
 652            "Source length exceeds Target capacity";
 653       end if;
 654
 655       Clear (Target);
 656
 657       if Source.Length = 0 then
 658          return;
 659       end if;
 660
 661       X := HT_Ops.First (Source);
 662       while X /= 0 loop
 663          Insert (Target, NN (X).Key, NN (X).Element);  -- optimize???
 664
 665          Y := HT_Ops.Next (Source, X);
 666
 667          HT_Ops.Delete_Node_Sans_Free (Source, X);
 668          Free (Source, X);
 669
 670          X := Y;
 671       end loop;
 672    end Move;
 673
 674    ----------
 675    -- Next --
 676    ----------
 677
 678    function Next (Node : Node_Type) return Count_Type is
 679    begin
 680       return Node.Next;
 681    end Next;
 682
 683    function Next (Container : Map; Position : Cursor) return Cursor is
 684    begin
 685       if Position.Node = 0 then
 686          return No_Element;
 687       end if;
 688
 689       if not Has_Element (Container, Position) then
 690          raise Constraint_Error
 691            with "Position has no element";
 692       end if;
 693
 694       pragma Assert (Vet (Container, Position), "bad cursor in function Next");
 695
 696       declare
 697          Node : constant Count_Type := HT_Ops.Next (Container, Position.Node);
 698
 699       begin
 700          if Node = 0 then
 701             return No_Element;
 702          end if;
 703
 704          return (Node => Node);
 705       end;
 706    end Next;
 707
 708    procedure Next (Container : Map; Position : in out Cursor) is
 709    begin
 710       Position := Next (Container, Position);
 711    end Next;
 712
 713    -------------
 714    -- Overlap --
 715    -------------
 716
 717    function Overlap (Left, Right : Map) return Boolean is
 718       Left_Node  : Count_Type;
 719       Left_Nodes : Nodes_Type renames Left.Nodes;
 720
 721    begin
 722       if Length (Right) = 0 or Length (Left) = 0 then
 723          return False;
 724       end if;
 725
 726       if Left'Address = Right'Address then
 727          return True;
 728       end if;
 729
 730       Left_Node := First (Left).Node;
 731       while Left_Node /= 0 loop
 732          declare
 733             N : Node_Type renames Left_Nodes (Left_Node);
 734             E : Key_Type renames N.Key;
 735          begin
 736             if Find (Right, E).Node /= 0 then
 737                return True;
 738             end if;
 739          end;
 740
 741          Left_Node := HT_Ops.Next (Left, Left_Node);
 742       end loop;
 743
 744       return False;
 745    end Overlap;
 746
 747    -------------
 748    -- Replace --
 749    -------------
 750
 751    procedure Replace
 752      (Container : in out Map;
 753       Key       : Key_Type;
 754       New_Item  : Element_Type)
 755    is
 756       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 757
 758    begin
 759       if Node = 0 then
 760          raise Constraint_Error with
 761            "attempt to replace key not in map";
 762       end if;
 763
 764       declare
 765          N : Node_Type renames Container.Nodes (Node);
 766       begin
 767          N.Key := Key;
 768          N.Element := New_Item;
 769       end;
 770    end Replace;
 771
 772    ---------------------
 773    -- Replace_Element --
 774    ---------------------
 775
 776    procedure Replace_Element
 777      (Container : in out Map;
 778       Position  : Cursor;
 779       New_Item  : Element_Type)
 780    is
 781    begin
 782       if not Has_Element (Container, Position) then
 783          raise Constraint_Error with
 784            "Position cursor of Replace_Element has no element";
 785       end if;
 786
 787       pragma Assert (Vet (Container, Position),
 788                      "bad cursor in Replace_Element");
 789
 790       Container.Nodes (Position.Node).Element := New_Item;
 791    end Replace_Element;
 792
 793    ----------------------
 794    -- Reserve_Capacity --
 795    ----------------------
 796
 797    procedure Reserve_Capacity
 798      (Container : in out Map;
 799       Capacity  : Count_Type)
 800    is
 801    begin
 802       if Capacity > Container.Capacity then
 803          raise Capacity_Error with "requested capacity is too large";
 804       end if;
 805    end Reserve_Capacity;
 806
 807    -----------
 808    -- Right --
 809    -----------
 810
 811    function Right (Container : Map; Position : Cursor) return Map is
 812       Curs : Cursor := First (Container);
 813       C    : Map (Container.Capacity, Container.Modulus) :=
 814         Copy (Container, Container.Capacity);
 815       Node : Count_Type;
 816
 817    begin
 818       if Curs = No_Element then
 819          Clear (C);
 820          return C;
 821       end if;
 822
 823       if Position /= No_Element and not Has_Element (Container, Position) then
 824          raise Constraint_Error;
 825       end if;
 826
 827       while Curs.Node /= Position.Node loop
 828          Node := Curs.Node;
 829          Delete (C, Curs);
 830          Curs := Next (Container, (Node => Node));
 831       end loop;
 832
 833       return C;
 834    end Right;
 835
 836    --------------
 837    -- Set_Next --
 838    --------------
 839
 840    procedure Set_Next (Node : in out Node_Type; Next : Count_Type) is
 841    begin
 842       Node.Next := Next;
 843    end Set_Next;
 844
 845    ------------------
 846    -- Strict_Equal --
 847    ------------------
 848
 849    function Strict_Equal (Left, Right : Map) return Boolean is
 850       CuL : Cursor := First (Left);
 851       CuR : Cursor := First (Right);
 852
 853    begin
 854       if Length (Left) /= Length (Right) then
 855          return False;
 856       end if;
 857
 858       while CuL.Node /= 0 or CuR.Node /= 0 loop
 859          if CuL.Node /= CuR.Node or else
 860            (Left.Nodes (CuL.Node).Element /=
 861               Right.Nodes (CuR.Node).Element or
 862               Left.Nodes (CuL.Node).Key /=
 863               Right.Nodes (CuR.Node).Key) then
 864             return False;
 865          end if;
 866
 867          CuL := Next (Left, CuL);
 868          CuR := Next (Right, CuR);
 869       end loop;
 870
 871       return True;
 872    end Strict_Equal;
 873
 874    ---------
 875    -- Vet --
 876    ---------
 877
 878    function Vet (Container : Map; Position : Cursor) return Boolean is
 879    begin
 880       if Position.Node = 0 then
 881          return True;
 882       end if;
 883
 884       declare
 885          X : Count_Type;
 886
 887       begin
 888          if Container.Length = 0 then
 889             return False;
 890          end if;
 891
 892          if Container.Capacity = 0 then
 893             return False;
 894          end if;
 895
 896          if Container.Buckets'Length = 0 then
 897             return False;
 898          end if;
 899
 900          if Position.Node > Container.Capacity then
 901             return False;
 902          end if;
 903
 904          if Container.Nodes (Position.Node).Next = Position.Node then
 905             return False;
 906          end if;
 907
 908          X := Container.Buckets
 909            (Key_Ops.Index (Container, Container.Nodes (Position.Node).Key));
 910
 911          for J in 1 .. Container.Length loop
 912             if X = Position.Node then
 913                return True;
 914             end if;
 915
 916             if X = 0 then
 917                return False;
 918             end if;
 919
 920             if X = Container.Nodes (X).Next then
 921
 922                --  Prevent unnecessary looping
 923
 924                return False;
 925             end if;
 926
 927             X := Container.Nodes (X).Next;
 928          end loop;
 929
 930          return False;
 931       end;
 932    end Vet;
 933
 934 end Ada.Containers.Formal_Hashed_Maps;