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