gcc/ada/a-rbtgso.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --           ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_SET_OPERATIONS          --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-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 -- This unit was originally developed by Matthew J Heaney.                  --
  28 ------------------------------------------------------------------------------
  29
  30 with System; use type System.Address;
  31
  32 package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
  33
  34    -----------------------
  35    -- Local Subprograms --
  36    -----------------------
  37
  38    procedure Clear (Tree : in out Tree_Type);
  39
  40    function Copy (Source : Tree_Type) return Tree_Type;
  41
  42    -----------
  43    -- Clear --
  44    -----------
  45
  46    procedure Clear (Tree : in out Tree_Type) is
  47       pragma Assert (Tree.Busy = 0);
  48       pragma Assert (Tree.Lock = 0);
  49
  50       Root : Node_Access := Tree.Root;
  51       pragma Warnings (Off, Root);
  52
  53    begin
  54       Tree.Root := null;
  55       Tree.First := null;
  56       Tree.Last := null;
  57       Tree.Length := 0;
  58
  59       Delete_Tree (Root);
  60    end Clear;
  61
  62    ----------
  63    -- Copy --
  64    ----------
  65
  66    function Copy (Source : Tree_Type) return Tree_Type is
  67       Target : Tree_Type;
  68
  69    begin
  70       if Source.Length = 0 then
  71          return Target;
  72       end if;
  73
  74       Target.Root := Copy_Tree (Source.Root);
  75       Target.First := Tree_Operations.Min (Target.Root);
  76       Target.Last := Tree_Operations.Max (Target.Root);
  77       Target.Length := Source.Length;
  78
  79       return Target;
  80    end Copy;
  81
  82    ----------------
  83    -- Difference --
  84    ----------------
  85
  86    procedure Difference (Target : in out Tree_Type; Source : Tree_Type) is
  87       BT : Natural renames Target.Busy;
  88       LT : Natural renames Target.Lock;
  89
  90       BS : Natural renames Source'Unrestricted_Access.Busy;
  91       LS : Natural renames Source'Unrestricted_Access.Lock;
  92
  93       Tgt : Node_Access;
  94       Src : Node_Access;
  95
  96       Compare : Integer;
  97
  98    begin
  99       if Target'Address = Source'Address then
 100          if Target.Busy > 0 then
 101             raise Program_Error with
 102               "attempt to tamper with cursors (container is busy)";
 103          end if;
 104
 105          Clear (Target);
 106          return;
 107       end if;
 108
 109       if Source.Length = 0 then
 110          return;
 111       end if;
 112
 113       if Target.Busy > 0 then
 114          raise Program_Error with
 115            "attempt to tamper with cursors (container is busy)";
 116       end if;
 117
 118       Tgt := Target.First;
 119       Src := Source.First;
 120       loop
 121          if Tgt = null then
 122             exit;
 123          end if;
 124
 125          if Src = null then
 126             exit;
 127          end if;
 128
 129          --  Per AI05-0022, the container implementation is required to detect
 130          --  element tampering by a generic actual subprogram.
 131
 132          begin
 133             BT := BT + 1;
 134             LT := LT + 1;
 135
 136             BS := BS + 1;
 137             LS := LS + 1;
 138
 139             if Is_Less (Tgt, Src) then
 140                Compare := -1;
 141             elsif Is_Less (Src, Tgt) then
 142                Compare := 1;
 143             else
 144                Compare := 0;
 145             end if;
 146
 147             BT := BT - 1;
 148             LT := LT - 1;
 149
 150             BS := BS - 1;
 151             LS := LS - 1;
 152
 153          exception
 154             when others =>
 155                BT := BT - 1;
 156                LT := LT - 1;
 157
 158                BS := BS - 1;
 159                LS := LS - 1;
 160
 161                raise;
 162          end;
 163
 164          if Compare < 0 then
 165             Tgt := Tree_Operations.Next (Tgt);
 166
 167          elsif Compare > 0 then
 168             Src := Tree_Operations.Next (Src);
 169
 170          else
 171             declare
 172                X : Node_Access := Tgt;
 173             begin
 174                Tgt := Tree_Operations.Next (Tgt);
 175                Tree_Operations.Delete_Node_Sans_Free (Target, X);
 176                Free (X);
 177             end;
 178
 179             Src := Tree_Operations.Next (Src);
 180          end if;
 181       end loop;
 182    end Difference;
 183
 184    function Difference (Left, Right : Tree_Type) return Tree_Type is
 185    begin
 186       if Left'Address = Right'Address then
 187          return Tree_Type'(others => <>);  -- Empty set
 188       end if;
 189
 190       if Left.Length = 0 then
 191          return Tree_Type'(others => <>);  -- Empty set
 192       end if;
 193
 194       if Right.Length = 0 then
 195          return Copy (Left);
 196       end if;
 197
 198       --  Per AI05-0022, the container implementation is required to detect
 199       --  element tampering by a generic actual subprogram.
 200
 201       declare
 202          BL : Natural renames Left'Unrestricted_Access.Busy;
 203          LL : Natural renames Left'Unrestricted_Access.Lock;
 204
 205          BR : Natural renames Right'Unrestricted_Access.Busy;
 206          LR : Natural renames Right'Unrestricted_Access.Lock;
 207
 208          Tree : Tree_Type;
 209
 210          L_Node : Node_Access;
 211          R_Node : Node_Access;
 212
 213          Dst_Node : Node_Access;
 214          pragma Warnings (Off, Dst_Node);
 215
 216       begin
 217          BL := BL + 1;
 218          LL := LL + 1;
 219
 220          BR := BR + 1;
 221          LR := LR + 1;
 222
 223          L_Node := Left.First;
 224          R_Node := Right.First;
 225          loop
 226             if L_Node = null then
 227                exit;
 228             end if;
 229
 230             if R_Node = null then
 231                while L_Node /= null loop
 232                   Insert_With_Hint
 233                     (Dst_Tree => Tree,
 234                      Dst_Hint => null,
 235                      Src_Node => L_Node,
 236                      Dst_Node => Dst_Node);
 237
 238                   L_Node := Tree_Operations.Next (L_Node);
 239                end loop;
 240
 241                exit;
 242             end if;
 243
 244             if Is_Less (L_Node, R_Node) then
 245                Insert_With_Hint
 246                  (Dst_Tree => Tree,
 247                   Dst_Hint => null,
 248                   Src_Node => L_Node,
 249                   Dst_Node => Dst_Node);
 250
 251                L_Node := Tree_Operations.Next (L_Node);
 252
 253             elsif Is_Less (R_Node, L_Node) then
 254                R_Node := Tree_Operations.Next (R_Node);
 255
 256             else
 257                L_Node := Tree_Operations.Next (L_Node);
 258                R_Node := Tree_Operations.Next (R_Node);
 259             end if;
 260          end loop;
 261
 262          BL := BL - 1;
 263          LL := LL - 1;
 264
 265          BR := BR - 1;
 266          LR := LR - 1;
 267
 268          return Tree;
 269
 270       exception
 271          when others =>
 272             BL := BL - 1;
 273             LL := LL - 1;
 274
 275             BR := BR - 1;
 276             LR := LR - 1;
 277
 278             Delete_Tree (Tree.Root);
 279             raise;
 280       end;
 281    end Difference;
 282
 283    ------------------
 284    -- Intersection --
 285    ------------------
 286
 287    procedure Intersection
 288      (Target : in out Tree_Type;
 289       Source : Tree_Type)
 290    is
 291       BT : Natural renames Target.Busy;
 292       LT : Natural renames Target.Lock;
 293
 294       BS : Natural renames Source'Unrestricted_Access.Busy;
 295       LS : Natural renames Source'Unrestricted_Access.Lock;
 296
 297       Tgt : Node_Access;
 298       Src : Node_Access;
 299
 300       Compare : Integer;
 301
 302    begin
 303       if Target'Address = Source'Address then
 304          return;
 305       end if;
 306
 307       if Target.Busy > 0 then
 308          raise Program_Error with
 309            "attempt to tamper with cursors (container is busy)";
 310       end if;
 311
 312       if Source.Length = 0 then
 313          Clear (Target);
 314          return;
 315       end if;
 316
 317       Tgt := Target.First;
 318       Src := Source.First;
 319       while Tgt /= null
 320         and then Src /= null
 321       loop
 322          --  Per AI05-0022, the container implementation is required to detect
 323          --  element tampering by a generic actual subprogram.
 324
 325          begin
 326             BT := BT + 1;
 327             LT := LT + 1;
 328
 329             BS := BS + 1;
 330             LS := LS + 1;
 331
 332             if Is_Less (Tgt, Src) then
 333                Compare := -1;
 334             elsif Is_Less (Src, Tgt) then
 335                Compare := 1;
 336             else
 337                Compare := 0;
 338             end if;
 339
 340             BT := BT - 1;
 341             LT := LT - 1;
 342
 343             BS := BS - 1;
 344             LS := LS - 1;
 345
 346          exception
 347             when others =>
 348                BT := BT - 1;
 349                LT := LT - 1;
 350
 351                BS := BS - 1;
 352                LS := LS - 1;
 353
 354                raise;
 355          end;
 356
 357          if Compare < 0 then
 358             declare
 359                X : Node_Access := Tgt;
 360             begin
 361                Tgt := Tree_Operations.Next (Tgt);
 362                Tree_Operations.Delete_Node_Sans_Free (Target, X);
 363                Free (X);
 364             end;
 365
 366          elsif Compare > 0 then
 367             Src := Tree_Operations.Next (Src);
 368
 369          else
 370             Tgt := Tree_Operations.Next (Tgt);
 371             Src := Tree_Operations.Next (Src);
 372          end if;
 373       end loop;
 374
 375       while Tgt /= null loop
 376          declare
 377             X : Node_Access := Tgt;
 378          begin
 379             Tgt := Tree_Operations.Next (Tgt);
 380             Tree_Operations.Delete_Node_Sans_Free (Target, X);
 381             Free (X);
 382          end;
 383       end loop;
 384    end Intersection;
 385
 386    function Intersection (Left, Right : Tree_Type) return Tree_Type is
 387    begin
 388       if Left'Address = Right'Address then
 389          return Copy (Left);
 390       end if;
 391
 392       --  Per AI05-0022, the container implementation is required to detect
 393       --  element tampering by a generic actual subprogram.
 394
 395       declare
 396          BL : Natural renames Left'Unrestricted_Access.Busy;
 397          LL : Natural renames Left'Unrestricted_Access.Lock;
 398
 399          BR : Natural renames Right'Unrestricted_Access.Busy;
 400          LR : Natural renames Right'Unrestricted_Access.Lock;
 401
 402          Tree : Tree_Type;
 403
 404          L_Node : Node_Access;
 405          R_Node : Node_Access;
 406
 407          Dst_Node : Node_Access;
 408          pragma Warnings (Off, Dst_Node);
 409
 410       begin
 411          BL := BL + 1;
 412          LL := LL + 1;
 413
 414          BR := BR + 1;
 415          LR := LR + 1;
 416
 417          L_Node := Left.First;
 418          R_Node := Right.First;
 419          loop
 420             if L_Node = null then
 421                exit;
 422             end if;
 423
 424             if R_Node = null then
 425                exit;
 426             end if;
 427
 428             if Is_Less (L_Node, R_Node) then
 429                L_Node := Tree_Operations.Next (L_Node);
 430
 431             elsif Is_Less (R_Node, L_Node) then
 432                R_Node := Tree_Operations.Next (R_Node);
 433
 434             else
 435                Insert_With_Hint
 436                  (Dst_Tree => Tree,
 437                   Dst_Hint => null,
 438                   Src_Node => L_Node,
 439                   Dst_Node => Dst_Node);
 440
 441                L_Node := Tree_Operations.Next (L_Node);
 442                R_Node := Tree_Operations.Next (R_Node);
 443             end if;
 444          end loop;
 445
 446          BL := BL - 1;
 447          LL := LL - 1;
 448
 449          BR := BR - 1;
 450          LR := LR - 1;
 451
 452          return Tree;
 453
 454       exception
 455          when others =>
 456             BL := BL - 1;
 457             LL := LL - 1;
 458
 459             BR := BR - 1;
 460             LR := LR - 1;
 461
 462             Delete_Tree (Tree.Root);
 463             raise;
 464       end;
 465    end Intersection;
 466
 467    ---------------
 468    -- Is_Subset --
 469    ---------------
 470
 471    function Is_Subset
 472      (Subset : Tree_Type;
 473       Of_Set : Tree_Type) return Boolean
 474    is
 475    begin
 476       if Subset'Address = Of_Set'Address then
 477          return True;
 478       end if;
 479
 480       if Subset.Length > Of_Set.Length then
 481          return False;
 482       end if;
 483
 484       --  Per AI05-0022, the container implementation is required to detect
 485       --  element tampering by a generic actual subprogram.
 486
 487       declare
 488          BL : Natural renames Subset'Unrestricted_Access.Busy;
 489          LL : Natural renames Subset'Unrestricted_Access.Lock;
 490
 491          BR : Natural renames Of_Set'Unrestricted_Access.Busy;
 492          LR : Natural renames Of_Set'Unrestricted_Access.Lock;
 493
 494          Subset_Node : Node_Access;
 495          Set_Node    : Node_Access;
 496
 497          Result : Boolean;
 498
 499       begin
 500          BL := BL + 1;
 501          LL := LL + 1;
 502
 503          BR := BR + 1;
 504          LR := LR + 1;
 505
 506          Subset_Node := Subset.First;
 507          Set_Node    := Of_Set.First;
 508          loop
 509             if Set_Node = null then
 510                Result := Subset_Node = null;
 511                exit;
 512             end if;
 513
 514             if Subset_Node = null then
 515                Result := True;
 516                exit;
 517             end if;
 518
 519             if Is_Less (Subset_Node, Set_Node) then
 520                Result := False;
 521                exit;
 522             end if;
 523
 524             if Is_Less (Set_Node, Subset_Node) then
 525                Set_Node := Tree_Operations.Next (Set_Node);
 526             else
 527                Set_Node := Tree_Operations.Next (Set_Node);
 528                Subset_Node := Tree_Operations.Next (Subset_Node);
 529             end if;
 530          end loop;
 531
 532          BL := BL - 1;
 533          LL := LL - 1;
 534
 535          BR := BR - 1;
 536          LR := LR - 1;
 537
 538          return Result;
 539
 540       exception
 541          when others =>
 542             BL := BL - 1;
 543             LL := LL - 1;
 544
 545             BR := BR - 1;
 546             LR := LR - 1;
 547
 548             raise;
 549       end;
 550    end Is_Subset;
 551
 552    -------------
 553    -- Overlap --
 554    -------------
 555
 556    function Overlap (Left, Right : Tree_Type) return Boolean is
 557    begin
 558       if Left'Address = Right'Address then
 559          return Left.Length /= 0;
 560       end if;
 561
 562       --  Per AI05-0022, the container implementation is required to detect
 563       --  element tampering by a generic actual subprogram.
 564
 565       declare
 566          BL : Natural renames Left'Unrestricted_Access.Busy;
 567          LL : Natural renames Left'Unrestricted_Access.Lock;
 568
 569          BR : Natural renames Right'Unrestricted_Access.Busy;
 570          LR : Natural renames Right'Unrestricted_Access.Lock;
 571
 572          L_Node : Node_Access;
 573          R_Node : Node_Access;
 574
 575          Result : Boolean;
 576
 577       begin
 578          BL := BL + 1;
 579          LL := LL + 1;
 580
 581          BR := BR + 1;
 582          LR := LR + 1;
 583
 584          L_Node := Left.First;
 585          R_Node := Right.First;
 586          loop
 587             if L_Node = null
 588               or else R_Node = null
 589             then
 590                Result := False;
 591                exit;
 592             end if;
 593
 594             if Is_Less (L_Node, R_Node) then
 595                L_Node := Tree_Operations.Next (L_Node);
 596
 597             elsif Is_Less (R_Node, L_Node) then
 598                R_Node := Tree_Operations.Next (R_Node);
 599
 600             else
 601                Result := True;
 602                exit;
 603             end if;
 604          end loop;
 605
 606          BL := BL - 1;
 607          LL := LL - 1;
 608
 609          BR := BR - 1;
 610          LR := LR - 1;
 611
 612          return Result;
 613
 614       exception
 615          when others =>
 616             BL := BL - 1;
 617             LL := LL - 1;
 618
 619             BR := BR - 1;
 620             LR := LR - 1;
 621
 622             raise;
 623       end;
 624    end Overlap;
 625
 626    --------------------------
 627    -- Symmetric_Difference --
 628    --------------------------
 629
 630    procedure Symmetric_Difference
 631      (Target : in out Tree_Type;
 632       Source : Tree_Type)
 633    is
 634       BT : Natural renames Target.Busy;
 635       LT : Natural renames Target.Lock;
 636
 637       BS : Natural renames Source'Unrestricted_Access.Busy;
 638       LS : Natural renames Source'Unrestricted_Access.Lock;
 639
 640       Tgt : Node_Access;
 641       Src : Node_Access;
 642
 643       New_Tgt_Node : Node_Access;
 644       pragma Warnings (Off, New_Tgt_Node);
 645
 646       Compare : Integer;
 647
 648    begin
 649       if Target'Address = Source'Address then
 650          Clear (Target);
 651          return;
 652       end if;
 653
 654       Tgt := Target.First;
 655       Src := Source.First;
 656       loop
 657          if Tgt = null then
 658             while Src /= null loop
 659                Insert_With_Hint
 660                  (Dst_Tree => Target,
 661                   Dst_Hint => null,
 662                   Src_Node => Src,
 663                   Dst_Node => New_Tgt_Node);
 664
 665                Src := Tree_Operations.Next (Src);
 666             end loop;
 667
 668             return;
 669          end if;
 670
 671          if Src = null then
 672             return;
 673          end if;
 674
 675          --  Per AI05-0022, the container implementation is required to detect
 676          --  element tampering by a generic actual subprogram.
 677
 678          begin
 679             BT := BT + 1;
 680             LT := LT + 1;
 681
 682             BS := BS + 1;
 683             LS := LS + 1;
 684
 685             if Is_Less (Tgt, Src) then
 686                Compare := -1;
 687             elsif Is_Less (Src, Tgt) then
 688                Compare := 1;
 689             else
 690                Compare := 0;
 691             end if;
 692
 693             BT := BT - 1;
 694             LT := LT - 1;
 695
 696             BS := BS - 1;
 697             LS := LS - 1;
 698
 699          exception
 700             when others =>
 701                BT := BT - 1;
 702                LT := LT - 1;
 703
 704                BS := BS - 1;
 705                LS := LS - 1;
 706
 707                raise;
 708          end;
 709
 710          if Compare < 0 then
 711             Tgt := Tree_Operations.Next (Tgt);
 712
 713          elsif Compare > 0 then
 714             Insert_With_Hint
 715               (Dst_Tree => Target,
 716                Dst_Hint => Tgt,
 717                Src_Node => Src,
 718                Dst_Node => New_Tgt_Node);
 719
 720             Src := Tree_Operations.Next (Src);
 721
 722          else
 723             declare
 724                X : Node_Access := Tgt;
 725             begin
 726                Tgt := Tree_Operations.Next (Tgt);
 727                Tree_Operations.Delete_Node_Sans_Free (Target, X);
 728                Free (X);
 729             end;
 730
 731             Src := Tree_Operations.Next (Src);
 732          end if;
 733       end loop;
 734    end Symmetric_Difference;
 735
 736    function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is
 737    begin
 738       if Left'Address = Right'Address then
 739          return Tree_Type'(others => <>);  -- Empty set
 740       end if;
 741
 742       if Right.Length = 0 then
 743          return Copy (Left);
 744       end if;
 745
 746       if Left.Length = 0 then
 747          return Copy (Right);
 748       end if;
 749
 750       --  Per AI05-0022, the container implementation is required to detect
 751       --  element tampering by a generic actual subprogram.
 752
 753       declare
 754          BL : Natural renames Left'Unrestricted_Access.Busy;
 755          LL : Natural renames Left'Unrestricted_Access.Lock;
 756
 757          BR : Natural renames Right'Unrestricted_Access.Busy;
 758          LR : Natural renames Right'Unrestricted_Access.Lock;
 759
 760          Tree : Tree_Type;
 761
 762          L_Node : Node_Access;
 763          R_Node : Node_Access;
 764
 765          Dst_Node : Node_Access;
 766          pragma Warnings (Off, Dst_Node);
 767
 768       begin
 769          BL := BL + 1;
 770          LL := LL + 1;
 771
 772          BR := BR + 1;
 773          LR := LR + 1;
 774
 775          L_Node := Left.First;
 776          R_Node := Right.First;
 777          loop
 778             if L_Node = null then
 779                while R_Node /= null loop
 780                   Insert_With_Hint
 781                     (Dst_Tree => Tree,
 782                      Dst_Hint => null,
 783                      Src_Node => R_Node,
 784                      Dst_Node => Dst_Node);
 785                   R_Node := Tree_Operations.Next (R_Node);
 786                end loop;
 787
 788                exit;
 789             end if;
 790
 791             if R_Node = null then
 792                while L_Node /= null loop
 793                   Insert_With_Hint
 794                     (Dst_Tree => Tree,
 795                      Dst_Hint => null,
 796                      Src_Node => L_Node,
 797                      Dst_Node => Dst_Node);
 798
 799                   L_Node := Tree_Operations.Next (L_Node);
 800                end loop;
 801
 802                exit;
 803             end if;
 804
 805             if Is_Less (L_Node, R_Node) then
 806                Insert_With_Hint
 807                  (Dst_Tree => Tree,
 808                   Dst_Hint => null,
 809                   Src_Node => L_Node,
 810                   Dst_Node => Dst_Node);
 811
 812                L_Node := Tree_Operations.Next (L_Node);
 813
 814             elsif Is_Less (R_Node, L_Node) then
 815                Insert_With_Hint
 816                  (Dst_Tree => Tree,
 817                   Dst_Hint => null,
 818                   Src_Node => R_Node,
 819                   Dst_Node => Dst_Node);
 820
 821                R_Node := Tree_Operations.Next (R_Node);
 822
 823             else
 824                L_Node := Tree_Operations.Next (L_Node);
 825                R_Node := Tree_Operations.Next (R_Node);
 826             end if;
 827          end loop;
 828
 829          BL := BL - 1;
 830          LL := LL - 1;
 831
 832          BR := BR - 1;
 833          LR := LR - 1;
 834
 835          return Tree;
 836
 837       exception
 838          when others =>
 839             BL := BL - 1;
 840             LL := LL - 1;
 841
 842             BR := BR - 1;
 843             LR := LR - 1;
 844
 845             Delete_Tree (Tree.Root);
 846             raise;
 847       end;
 848    end Symmetric_Difference;
 849
 850    -----------
 851    -- Union --
 852    -----------
 853
 854    procedure Union (Target : in out Tree_Type; Source : Tree_Type) is
 855       Hint : Node_Access;
 856
 857       procedure Process (Node : Node_Access);
 858       pragma Inline (Process);
 859
 860       procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
 861
 862       -------------
 863       -- Process --
 864       -------------
 865
 866       procedure Process (Node : Node_Access) is
 867       begin
 868          Insert_With_Hint
 869            (Dst_Tree => Target,
 870             Dst_Hint => Hint,  -- use node most recently inserted as hint
 871             Src_Node => Node,
 872             Dst_Node => Hint);
 873       end Process;
 874
 875    --  Start of processing for Union
 876
 877    begin
 878       if Target'Address = Source'Address then
 879          return;
 880       end if;
 881
 882       --  Per AI05-0022, the container implementation is required to detect
 883       --  element tampering by a generic actual subprogram.
 884
 885       declare
 886          BS : Natural renames Source'Unrestricted_Access.Busy;
 887          LS : Natural renames Source'Unrestricted_Access.Lock;
 888
 889       begin
 890          BS := BS + 1;
 891          LS := LS + 1;
 892
 893          Iterate (Source);
 894
 895          BS := BS - 1;
 896          LS := LS - 1;
 897
 898       exception
 899          when others =>
 900             BS := BS - 1;
 901             LS := LS - 1;
 902
 903             raise;
 904       end;
 905    end Union;
 906
 907    function Union (Left, Right : Tree_Type) return Tree_Type is
 908    begin
 909       if Left'Address = Right'Address then
 910          return Copy (Left);
 911       end if;
 912
 913       if Left.Length = 0 then
 914          return Copy (Right);
 915       end if;
 916
 917       if Right.Length = 0 then
 918          return Copy (Left);
 919       end if;
 920
 921       declare
 922          BL : Natural renames Left'Unrestricted_Access.Busy;
 923          LL : Natural renames Left'Unrestricted_Access.Lock;
 924
 925          BR : Natural renames Right'Unrestricted_Access.Busy;
 926          LR : Natural renames Right'Unrestricted_Access.Lock;
 927
 928          Tree : Tree_Type := Copy (Left);
 929
 930          Hint : Node_Access;
 931
 932          procedure Process (Node : Node_Access);
 933          pragma Inline (Process);
 934
 935          procedure Iterate is
 936            new Tree_Operations.Generic_Iteration (Process);
 937
 938          -------------
 939          -- Process --
 940          -------------
 941
 942          procedure Process (Node : Node_Access) is
 943          begin
 944             Insert_With_Hint
 945               (Dst_Tree => Tree,
 946                Dst_Hint => Hint,  -- use node most recently inserted as hint
 947                Src_Node => Node,
 948                Dst_Node => Hint);
 949          end Process;
 950
 951       --  Start of processing for Union
 952
 953       begin
 954          BL := BL + 1;
 955          LL := LL + 1;
 956
 957          BR := BR + 1;
 958          LR := LR + 1;
 959
 960          Iterate (Right);
 961
 962          BL := BL - 1;
 963          LL := LL - 1;
 964
 965          BR := BR - 1;
 966          LR := LR - 1;
 967
 968          return Tree;
 969
 970       exception
 971          when others =>
 972             BL := BL - 1;
 973             LL := LL - 1;
 974
 975             BR := BR - 1;
 976             LR := LR - 1;
 977
 978             Delete_Tree (Tree.Root);
 979             raise;
 980       end;
 981    end Union;
 982
 983 end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;