gcc/ada/a-stzunb-shared.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --      A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D       --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2011, 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 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Strings.Wide_Wide_Search;
  33 with Ada.Unchecked_Deallocation;
  34
  35 package body Ada.Strings.Wide_Wide_Unbounded is
  36
  37    use Ada.Strings.Wide_Wide_Maps;
  38
  39    Growth_Factor : constant := 32;
  40    --  The growth factor controls how much extra space is allocated when
  41    --  we have to increase the size of an allocated unbounded string. By
  42    --  allocating extra space, we avoid the need to reallocate on every
  43    --  append, particularly important when a string is built up by repeated
  44    --  append operations of small pieces. This is expressed as a factor so
  45    --  32 means add 1/32 of the length of the string as growth space.
  46
  47    Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
  48    --  Allocation will be done by a multiple of Min_Mul_Alloc. This causes
  49    --  no memory loss as most (all?) malloc implementations are obliged to
  50    --  align the returned memory on the maximum alignment as malloc does not
  51    --  know the target alignment.
  52
  53    function Aligned_Max_Length (Max_Length : Natural) return Natural;
  54    --  Returns recommended length of the shared string which is greater or
  55    --  equal to specified length. Calculation take in sense alignment of
  56    --  the allocated memory segments to use memory effectively by
  57    --  Append/Insert/etc operations.
  58
  59    ---------
  60    -- "&" --
  61    ---------
  62
  63    function "&"
  64      (Left  : Unbounded_Wide_Wide_String;
  65       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
  66    is
  67       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
  68       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
  69       DL : constant Natural := LR.Last + RR.Last;
  70       DR : Shared_Wide_Wide_String_Access;
  71
  72    begin
  73       --  Result is an empty string, reuse shared empty string
  74
  75       if DL = 0 then
  76          Reference (Empty_Shared_Wide_Wide_String'Access);
  77          DR := Empty_Shared_Wide_Wide_String'Access;
  78
  79       --  Left string is empty, return Rigth string
  80
  81       elsif LR.Last = 0 then
  82          Reference (RR);
  83          DR := RR;
  84
  85       --  Right string is empty, return Left string
  86
  87       elsif RR.Last = 0 then
  88          Reference (LR);
  89          DR := LR;
  90
  91       --  Overwise, allocate new shared string and fill data
  92
  93       else
  94          DR := Allocate (LR.Last + RR.Last);
  95          DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
  96          DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
  97          DR.Last := DL;
  98       end if;
  99
 100       return (AF.Controlled with Reference => DR);
 101    end "&";
 102
 103    function "&"
 104      (Left  : Unbounded_Wide_Wide_String;
 105       Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
 106    is
 107       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 108       DL : constant Natural := LR.Last + Right'Length;
 109       DR : Shared_Wide_Wide_String_Access;
 110
 111    begin
 112       --  Result is an empty string, reuse shared empty string
 113
 114       if DL = 0 then
 115          Reference (Empty_Shared_Wide_Wide_String'Access);
 116          DR := Empty_Shared_Wide_Wide_String'Access;
 117
 118       --  Right is an empty string, return Left string
 119
 120       elsif Right'Length = 0 then
 121          Reference (LR);
 122          DR := LR;
 123
 124       --  Otherwise, allocate new shared string and fill it
 125
 126       else
 127          DR := Allocate (DL);
 128          DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
 129          DR.Data (LR.Last + 1 .. DL) := Right;
 130          DR.Last := DL;
 131       end if;
 132
 133       return (AF.Controlled with Reference => DR);
 134    end "&";
 135
 136    function "&"
 137      (Left  : Wide_Wide_String;
 138       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 139    is
 140       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 141       DL : constant Natural := Left'Length + RR.Last;
 142       DR : Shared_Wide_Wide_String_Access;
 143
 144    begin
 145       --  Result is an empty string, reuse shared one
 146
 147       if DL = 0 then
 148          Reference (Empty_Shared_Wide_Wide_String'Access);
 149          DR := Empty_Shared_Wide_Wide_String'Access;
 150
 151       --  Left is empty string, return Right string
 152
 153       elsif Left'Length = 0 then
 154          Reference (RR);
 155          DR := RR;
 156
 157       --  Otherwise, allocate new shared string and fill it
 158
 159       else
 160          DR := Allocate (DL);
 161          DR.Data (1 .. Left'Length) := Left;
 162          DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
 163          DR.Last := DL;
 164       end if;
 165
 166       return (AF.Controlled with Reference => DR);
 167    end "&";
 168
 169    function "&"
 170      (Left  : Unbounded_Wide_Wide_String;
 171       Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
 172    is
 173       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 174       DL : constant Natural := LR.Last + 1;
 175       DR : Shared_Wide_Wide_String_Access;
 176
 177    begin
 178       DR := Allocate (DL);
 179       DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
 180       DR.Data (DL) := Right;
 181       DR.Last := DL;
 182
 183       return (AF.Controlled with Reference => DR);
 184    end "&";
 185
 186    function "&"
 187      (Left  : Wide_Wide_Character;
 188       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 189    is
 190       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 191       DL : constant Natural := 1 + RR.Last;
 192       DR : Shared_Wide_Wide_String_Access;
 193
 194    begin
 195       DR := Allocate (DL);
 196       DR.Data (1) := Left;
 197       DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
 198       DR.Last := DL;
 199
 200       return (AF.Controlled with Reference => DR);
 201    end "&";
 202
 203    ---------
 204    -- "*" --
 205    ---------
 206
 207    function "*"
 208      (Left  : Natural;
 209       Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
 210    is
 211       DR : Shared_Wide_Wide_String_Access;
 212
 213    begin
 214       --  Result is an empty string, reuse shared empty string
 215
 216       if Left = 0 then
 217          Reference (Empty_Shared_Wide_Wide_String'Access);
 218          DR := Empty_Shared_Wide_Wide_String'Access;
 219
 220       --  Otherwise, allocate new shared string and fill it
 221
 222       else
 223          DR := Allocate (Left);
 224
 225          for J in 1 .. Left loop
 226             DR.Data (J) := Right;
 227          end loop;
 228
 229          DR.Last := Left;
 230       end if;
 231
 232       return (AF.Controlled with Reference => DR);
 233    end "*";
 234
 235    function "*"
 236      (Left  : Natural;
 237       Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
 238    is
 239       DL : constant Natural := Left * Right'Length;
 240       DR : Shared_Wide_Wide_String_Access;
 241       K  : Positive;
 242
 243    begin
 244       --  Result is an empty string, reuse shared empty string
 245
 246       if DL = 0 then
 247          Reference (Empty_Shared_Wide_Wide_String'Access);
 248          DR := Empty_Shared_Wide_Wide_String'Access;
 249
 250       --  Otherwise, allocate new shared string and fill it
 251
 252       else
 253          DR := Allocate (DL);
 254          K := 1;
 255
 256          for J in 1 .. Left loop
 257             DR.Data (K .. K + Right'Length - 1) := Right;
 258             K := K + Right'Length;
 259          end loop;
 260
 261          DR.Last := DL;
 262       end if;
 263
 264       return (AF.Controlled with Reference => DR);
 265    end "*";
 266
 267    function "*"
 268      (Left  : Natural;
 269       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 270    is
 271       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 272       DL : constant Natural := Left * RR.Last;
 273       DR : Shared_Wide_Wide_String_Access;
 274       K  : Positive;
 275
 276    begin
 277       --  Result is an empty string, reuse shared empty string
 278
 279       if DL = 0 then
 280          Reference (Empty_Shared_Wide_Wide_String'Access);
 281          DR := Empty_Shared_Wide_Wide_String'Access;
 282
 283       --  Coefficient is one, just return string itself
 284
 285       elsif Left = 1 then
 286          Reference (RR);
 287          DR := RR;
 288
 289       --  Otherwise, allocate new shared string and fill it
 290
 291       else
 292          DR := Allocate (DL);
 293          K := 1;
 294
 295          for J in 1 .. Left loop
 296             DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
 297             K := K + RR.Last;
 298          end loop;
 299
 300          DR.Last := DL;
 301       end if;
 302
 303       return (AF.Controlled with Reference => DR);
 304    end "*";
 305
 306    ---------
 307    -- "<" --
 308    ---------
 309
 310    function "<"
 311      (Left  : Unbounded_Wide_Wide_String;
 312       Right : Unbounded_Wide_Wide_String) return Boolean
 313    is
 314       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 315       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 316    begin
 317       return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
 318    end "<";
 319
 320    function "<"
 321      (Left  : Unbounded_Wide_Wide_String;
 322       Right : Wide_Wide_String) return Boolean
 323    is
 324       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 325    begin
 326       return LR.Data (1 .. LR.Last) < Right;
 327    end "<";
 328
 329    function "<"
 330      (Left  : Wide_Wide_String;
 331       Right : Unbounded_Wide_Wide_String) return Boolean
 332    is
 333       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 334    begin
 335       return Left < RR.Data (1 .. RR.Last);
 336    end "<";
 337
 338    ----------
 339    -- "<=" --
 340    ----------
 341
 342    function "<="
 343      (Left  : Unbounded_Wide_Wide_String;
 344       Right : Unbounded_Wide_Wide_String) return Boolean
 345    is
 346       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 347       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 348
 349    begin
 350       --  LR = RR means two strings shares shared string, thus they are equal
 351
 352       return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
 353    end "<=";
 354
 355    function "<="
 356      (Left  : Unbounded_Wide_Wide_String;
 357       Right : Wide_Wide_String) return Boolean
 358    is
 359       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 360    begin
 361       return LR.Data (1 .. LR.Last) <= Right;
 362    end "<=";
 363
 364    function "<="
 365      (Left  : Wide_Wide_String;
 366       Right : Unbounded_Wide_Wide_String) return Boolean
 367    is
 368       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 369    begin
 370       return Left <= RR.Data (1 .. RR.Last);
 371    end "<=";
 372
 373    ---------
 374    -- "=" --
 375    ---------
 376
 377    function "="
 378      (Left  : Unbounded_Wide_Wide_String;
 379       Right : Unbounded_Wide_Wide_String) return Boolean
 380    is
 381       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 382       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 383
 384    begin
 385       return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
 386       --  LR = RR means two strings shares shared string, thus they are equal
 387    end "=";
 388
 389    function "="
 390      (Left  : Unbounded_Wide_Wide_String;
 391       Right : Wide_Wide_String) return Boolean
 392    is
 393       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 394    begin
 395       return LR.Data (1 .. LR.Last) = Right;
 396    end "=";
 397
 398    function "="
 399      (Left  : Wide_Wide_String;
 400       Right : Unbounded_Wide_Wide_String) return Boolean
 401    is
 402       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 403    begin
 404       return Left = RR.Data (1 .. RR.Last);
 405    end "=";
 406
 407    ---------
 408    -- ">" --
 409    ---------
 410
 411    function ">"
 412      (Left  : Unbounded_Wide_Wide_String;
 413       Right : Unbounded_Wide_Wide_String) return Boolean
 414    is
 415       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 416       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 417    begin
 418       return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
 419    end ">";
 420
 421    function ">"
 422      (Left  : Unbounded_Wide_Wide_String;
 423       Right : Wide_Wide_String) return Boolean
 424    is
 425       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 426    begin
 427       return LR.Data (1 .. LR.Last) > Right;
 428    end ">";
 429
 430    function ">"
 431      (Left  : Wide_Wide_String;
 432       Right : Unbounded_Wide_Wide_String) return Boolean
 433    is
 434       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 435    begin
 436       return Left > RR.Data (1 .. RR.Last);
 437    end ">";
 438
 439    ----------
 440    -- ">=" --
 441    ----------
 442
 443    function ">="
 444      (Left  : Unbounded_Wide_Wide_String;
 445       Right : Unbounded_Wide_Wide_String) return Boolean
 446    is
 447       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 448       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 449
 450    begin
 451       --  LR = RR means two strings shares shared string, thus they are equal
 452
 453       return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
 454    end ">=";
 455
 456    function ">="
 457      (Left  : Unbounded_Wide_Wide_String;
 458       Right : Wide_Wide_String) return Boolean
 459    is
 460       LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
 461    begin
 462       return LR.Data (1 .. LR.Last) >= Right;
 463    end ">=";
 464
 465    function ">="
 466      (Left  : Wide_Wide_String;
 467       Right : Unbounded_Wide_Wide_String) return Boolean
 468    is
 469       RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
 470    begin
 471       return Left >= RR.Data (1 .. RR.Last);
 472    end ">=";
 473
 474    ------------
 475    -- Adjust --
 476    ------------
 477
 478    procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
 479    begin
 480       Reference (Object.Reference);
 481    end Adjust;
 482
 483    ------------------------
 484    -- Aligned_Max_Length --
 485    ------------------------
 486
 487    function Aligned_Max_Length (Max_Length : Natural) return Natural is
 488       Static_Size  : constant Natural :=
 489                        Empty_Shared_Wide_Wide_String'Size
 490                          / Standard'Storage_Unit;
 491       --  Total size of all static components
 492
 493       Element_Size : constant Natural :=
 494                        Wide_Wide_Character'Size / Standard'Storage_Unit;
 495
 496    begin
 497       return
 498         (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
 499           * Min_Mul_Alloc - Static_Size) / Element_Size;
 500    end Aligned_Max_Length;
 501
 502    --------------
 503    -- Allocate --
 504    --------------
 505
 506    function Allocate
 507      (Max_Length : Natural) return Shared_Wide_Wide_String_Access is
 508    begin
 509       --  Empty string requested, return shared empty string
 510
 511       if Max_Length = 0 then
 512          Reference (Empty_Shared_Wide_Wide_String'Access);
 513          return Empty_Shared_Wide_Wide_String'Access;
 514
 515       --  Otherwise, allocate requested space (and probably some more room)
 516
 517       else
 518          return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length));
 519       end if;
 520    end Allocate;
 521
 522    ------------
 523    -- Append --
 524    ------------
 525
 526    procedure Append
 527      (Source   : in out Unbounded_Wide_Wide_String;
 528       New_Item : Unbounded_Wide_Wide_String)
 529    is
 530       SR  : constant Shared_Wide_Wide_String_Access := Source.Reference;
 531       NR  : constant Shared_Wide_Wide_String_Access := New_Item.Reference;
 532       DL  : constant Natural              := SR.Last + NR.Last;
 533       DR  : Shared_Wide_Wide_String_Access;
 534
 535    begin
 536       --  Source is an empty string, reuse New_Item data
 537
 538       if SR.Last = 0 then
 539          Reference (NR);
 540          Source.Reference := NR;
 541          Unreference (SR);
 542
 543       --  New_Item is empty string, nothing to do
 544
 545       elsif NR.Last = 0 then
 546          null;
 547
 548       --  Try to reuse existent shared string
 549
 550       elsif Can_Be_Reused (SR, DL) then
 551          SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 552          SR.Last := DL;
 553
 554       --  Otherwise, allocate new one and fill it
 555
 556       else
 557          DR := Allocate (DL + DL / Growth_Factor);
 558          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 559          DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 560          DR.Last := DL;
 561          Source.Reference := DR;
 562          Unreference (SR);
 563       end if;
 564    end Append;
 565
 566    procedure Append
 567      (Source   : in out Unbounded_Wide_Wide_String;
 568       New_Item : Wide_Wide_String)
 569    is
 570       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 571       DL : constant Natural := SR.Last + New_Item'Length;
 572       DR : Shared_Wide_Wide_String_Access;
 573
 574    begin
 575       --  New_Item is an empty string, nothing to do
 576
 577       if New_Item'Length = 0 then
 578          null;
 579
 580       --  Try to reuse existing shared string
 581
 582       elsif Can_Be_Reused (SR, DL) then
 583          SR.Data (SR.Last + 1 .. DL) := New_Item;
 584          SR.Last := DL;
 585
 586       --  Otherwise, allocate new one and fill it
 587
 588       else
 589          DR := Allocate (DL + DL / Growth_Factor);
 590          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 591          DR.Data (SR.Last + 1 .. DL) := New_Item;
 592          DR.Last := DL;
 593          Source.Reference := DR;
 594          Unreference (SR);
 595       end if;
 596    end Append;
 597
 598    procedure Append
 599      (Source   : in out Unbounded_Wide_Wide_String;
 600       New_Item : Wide_Wide_Character)
 601    is
 602       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 603       DL : constant Natural := SR.Last + 1;
 604       DR : Shared_Wide_Wide_String_Access;
 605
 606    begin
 607       --  Try to reuse existing shared string
 608
 609       if Can_Be_Reused (SR, SR.Last + 1) then
 610          SR.Data (SR.Last + 1) := New_Item;
 611          SR.Last := SR.Last + 1;
 612
 613       --  Otherwise, allocate new one and fill it
 614
 615       else
 616          DR := Allocate (DL + DL / Growth_Factor);
 617          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 618          DR.Data (DL) := New_Item;
 619          DR.Last := DL;
 620          Source.Reference := DR;
 621          Unreference (SR);
 622       end if;
 623    end Append;
 624
 625    -------------------
 626    -- Can_Be_Reused --
 627    -------------------
 628
 629    function Can_Be_Reused
 630      (Item   : Shared_Wide_Wide_String_Access;
 631       Length : Natural) return Boolean is
 632    begin
 633       return
 634         System.Atomic_Counters.Is_One (Item.Counter)
 635           and then Item.Max_Length >= Length
 636           and then Item.Max_Length <=
 637                      Aligned_Max_Length (Length + Length / Growth_Factor);
 638    end Can_Be_Reused;
 639
 640    -----------
 641    -- Count --
 642    -----------
 643
 644    function Count
 645      (Source  : Unbounded_Wide_Wide_String;
 646       Pattern : Wide_Wide_String;
 647       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 648                   Wide_Wide_Maps.Identity)
 649       return Natural
 650    is
 651       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 652    begin
 653       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 654    end Count;
 655
 656    function Count
 657      (Source  : Unbounded_Wide_Wide_String;
 658       Pattern : Wide_Wide_String;
 659       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 660       return Natural
 661    is
 662       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 663    begin
 664       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 665    end Count;
 666
 667    function Count
 668      (Source : Unbounded_Wide_Wide_String;
 669       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 670    is
 671       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 672    begin
 673       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
 674    end Count;
 675
 676    ------------
 677    -- Delete --
 678    ------------
 679
 680    function Delete
 681      (Source  : Unbounded_Wide_Wide_String;
 682       From    : Positive;
 683       Through : Natural) return Unbounded_Wide_Wide_String
 684    is
 685       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 686       DL : Natural;
 687       DR : Shared_Wide_Wide_String_Access;
 688
 689    begin
 690       --  Empty slice is deleted, use the same shared string
 691
 692       if From > Through then
 693          Reference (SR);
 694          DR := SR;
 695
 696       --  Index is out of range
 697
 698       elsif Through > SR.Last then
 699          raise Index_Error;
 700
 701       --  Compute size of the result
 702
 703       else
 704          DL := SR.Last - (Through - From + 1);
 705
 706          --  Result is an empty string, reuse shared empty string
 707
 708          if DL = 0 then
 709             Reference (Empty_Shared_Wide_Wide_String'Access);
 710             DR := Empty_Shared_Wide_Wide_String'Access;
 711
 712          --  Otherwise, allocate new shared string and fill it
 713
 714          else
 715             DR := Allocate (DL);
 716             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 717             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 718             DR.Last := DL;
 719          end if;
 720       end if;
 721
 722       return (AF.Controlled with Reference => DR);
 723    end Delete;
 724
 725    procedure Delete
 726      (Source  : in out Unbounded_Wide_Wide_String;
 727       From    : Positive;
 728       Through : Natural)
 729    is
 730       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 731       DL : Natural;
 732       DR : Shared_Wide_Wide_String_Access;
 733
 734    begin
 735       --  Nothing changed, return
 736
 737       if From > Through then
 738          null;
 739
 740       --  Through is outside of the range
 741
 742       elsif Through > SR.Last then
 743          raise Index_Error;
 744
 745       else
 746          DL := SR.Last - (Through - From + 1);
 747
 748          --  Result is empty, reuse shared empty string
 749
 750          if DL = 0 then
 751             Reference (Empty_Shared_Wide_Wide_String'Access);
 752             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
 753             Unreference (SR);
 754
 755          --  Try to reuse existent shared string
 756
 757          elsif Can_Be_Reused (SR, DL) then
 758             SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 759             SR.Last := DL;
 760
 761          --  Otherwise, allocate new shared string
 762
 763          else
 764             DR := Allocate (DL);
 765             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 766             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 767             DR.Last := DL;
 768             Source.Reference := DR;
 769             Unreference (SR);
 770          end if;
 771       end if;
 772    end Delete;
 773
 774    -------------
 775    -- Element --
 776    -------------
 777
 778    function Element
 779      (Source : Unbounded_Wide_Wide_String;
 780       Index  : Positive) return Wide_Wide_Character
 781    is
 782       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 783    begin
 784       if Index <= SR.Last then
 785          return SR.Data (Index);
 786       else
 787          raise Index_Error;
 788       end if;
 789    end Element;
 790
 791    --------------
 792    -- Finalize --
 793    --------------
 794
 795    procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
 796       SR : constant Shared_Wide_Wide_String_Access := Object.Reference;
 797
 798    begin
 799       if SR /= null then
 800
 801          --  The same controlled object can be finalized several times for
 802          --  some reason. As per 7.6.1(24) this should have no ill effect,
 803          --  so we need to add a guard for the case of finalizing the same
 804          --  object twice.
 805
 806          Object.Reference := null;
 807          Unreference (SR);
 808       end if;
 809    end Finalize;
 810
 811    ----------------
 812    -- Find_Token --
 813    ----------------
 814
 815    procedure Find_Token
 816      (Source : Unbounded_Wide_Wide_String;
 817       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 818       From   : Positive;
 819       Test   : Strings.Membership;
 820       First  : out Positive;
 821       Last   : out Natural)
 822    is
 823       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 824    begin
 825       Wide_Wide_Search.Find_Token
 826         (SR.Data (From .. SR.Last), Set, Test, First, Last);
 827    end Find_Token;
 828
 829    procedure Find_Token
 830      (Source : Unbounded_Wide_Wide_String;
 831       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 832       Test   : Strings.Membership;
 833       First  : out Positive;
 834       Last   : out Natural)
 835    is
 836       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 837    begin
 838       Wide_Wide_Search.Find_Token
 839         (SR.Data (1 .. SR.Last), Set, Test, First, Last);
 840    end Find_Token;
 841
 842    ----------
 843    -- Free --
 844    ----------
 845
 846    procedure Free (X : in out Wide_Wide_String_Access) is
 847       procedure Deallocate is
 848          new Ada.Unchecked_Deallocation
 849                (Wide_Wide_String, Wide_Wide_String_Access);
 850    begin
 851       Deallocate (X);
 852    end Free;
 853
 854    ----------
 855    -- Head --
 856    ----------
 857
 858    function Head
 859      (Source : Unbounded_Wide_Wide_String;
 860       Count  : Natural;
 861       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 862       return Unbounded_Wide_Wide_String
 863    is
 864       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 865       DR : Shared_Wide_Wide_String_Access;
 866
 867    begin
 868       --  Result is empty, reuse shared empty string
 869
 870       if Count = 0 then
 871          Reference (Empty_Shared_Wide_Wide_String'Access);
 872          DR := Empty_Shared_Wide_Wide_String'Access;
 873
 874       --  Length of the string is the same as requested, reuse source shared
 875       --  string.
 876
 877       elsif Count = SR.Last then
 878          Reference (SR);
 879          DR := SR;
 880
 881       --  Otherwise, allocate new shared string and fill it
 882
 883       else
 884          DR := Allocate (Count);
 885
 886          --  Length of the source string is more than requested, copy
 887          --  corresponding slice.
 888
 889          if Count < SR.Last then
 890             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 891
 892          --  Length of the source string is less then requested, copy all
 893          --  contents and fill others by Pad character.
 894
 895          else
 896             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 897
 898             for J in SR.Last + 1 .. Count loop
 899                DR.Data (J) := Pad;
 900             end loop;
 901          end if;
 902
 903          DR.Last := Count;
 904       end if;
 905
 906       return (AF.Controlled with Reference => DR);
 907    end Head;
 908
 909    procedure Head
 910      (Source : in out Unbounded_Wide_Wide_String;
 911       Count  : Natural;
 912       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 913    is
 914       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 915       DR : Shared_Wide_Wide_String_Access;
 916
 917    begin
 918       --  Result is empty, reuse empty shared string
 919
 920       if Count = 0 then
 921          Reference (Empty_Shared_Wide_Wide_String'Access);
 922          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
 923          Unreference (SR);
 924
 925       --  Result is same with source string, reuse source shared string
 926
 927       elsif Count = SR.Last then
 928          null;
 929
 930       --  Try to reuse existent shared string
 931
 932       elsif Can_Be_Reused (SR, Count) then
 933          if Count > SR.Last then
 934             for J in SR.Last + 1 .. Count loop
 935                SR.Data (J) := Pad;
 936             end loop;
 937          end if;
 938
 939          SR.Last := Count;
 940
 941       --  Otherwise, allocate new shared string and fill it
 942
 943       else
 944          DR := Allocate (Count);
 945
 946          --  Length of the source string is greater then requested, copy
 947          --  corresponding slice.
 948
 949          if Count < SR.Last then
 950             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 951
 952          --  Length of the source string is less the requested, copy all
 953          --  exists data and fill others by Pad character.
 954
 955          else
 956             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 957
 958             for J in SR.Last + 1 .. Count loop
 959                DR.Data (J) := Pad;
 960             end loop;
 961          end if;
 962
 963          DR.Last := Count;
 964          Source.Reference := DR;
 965          Unreference (SR);
 966       end if;
 967    end Head;
 968
 969    -----------
 970    -- Index --
 971    -----------
 972
 973    function Index
 974      (Source  : Unbounded_Wide_Wide_String;
 975       Pattern : Wide_Wide_String;
 976       Going   : Strings.Direction := Strings.Forward;
 977       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 978                   Wide_Wide_Maps.Identity)
 979       return Natural
 980    is
 981       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 982    begin
 983       return Wide_Wide_Search.Index
 984         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 985    end Index;
 986
 987    function Index
 988      (Source  : Unbounded_Wide_Wide_String;
 989       Pattern : Wide_Wide_String;
 990       Going   : Direction := Forward;
 991       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 992       return Natural
 993    is
 994       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 995    begin
 996       return Wide_Wide_Search.Index
 997         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 998    end Index;
 999
1000    function Index
1001      (Source : Unbounded_Wide_Wide_String;
1002       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
1003       Test   : Strings.Membership := Strings.Inside;
1004       Going  : Strings.Direction  := Strings.Forward) return Natural
1005    is
1006       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1007    begin
1008       return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
1009    end Index;
1010
1011    function Index
1012      (Source  : Unbounded_Wide_Wide_String;
1013       Pattern : Wide_Wide_String;
1014       From    : Positive;
1015       Going   : Direction := Forward;
1016       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
1017                   Wide_Wide_Maps.Identity)
1018       return Natural
1019    is
1020       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1021    begin
1022       return Wide_Wide_Search.Index
1023         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1024    end Index;
1025
1026    function Index
1027      (Source  : Unbounded_Wide_Wide_String;
1028       Pattern : Wide_Wide_String;
1029       From    : Positive;
1030       Going   : Direction := Forward;
1031       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1032       return Natural
1033    is
1034       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1035    begin
1036       return Wide_Wide_Search.Index
1037         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1038    end Index;
1039
1040    function Index
1041      (Source  : Unbounded_Wide_Wide_String;
1042       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
1043       From    : Positive;
1044       Test    : Membership := Inside;
1045       Going   : Direction := Forward) return Natural
1046    is
1047       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1048    begin
1049       return Wide_Wide_Search.Index
1050         (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1051    end Index;
1052
1053    ---------------------
1054    -- Index_Non_Blank --
1055    ---------------------
1056
1057    function Index_Non_Blank
1058      (Source : Unbounded_Wide_Wide_String;
1059       Going  : Strings.Direction := Strings.Forward) return Natural
1060    is
1061       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1062    begin
1063       return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1064    end Index_Non_Blank;
1065
1066    function Index_Non_Blank
1067      (Source : Unbounded_Wide_Wide_String;
1068       From   : Positive;
1069       Going  : Direction := Forward) return Natural
1070    is
1071       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1072    begin
1073       return Wide_Wide_Search.Index_Non_Blank
1074         (SR.Data (1 .. SR.Last), From, Going);
1075    end Index_Non_Blank;
1076
1077    ----------------
1078    -- Initialize --
1079    ----------------
1080
1081    procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
1082    begin
1083       Reference (Object.Reference);
1084    end Initialize;
1085
1086    ------------
1087    -- Insert --
1088    ------------
1089
1090    function Insert
1091      (Source   : Unbounded_Wide_Wide_String;
1092       Before   : Positive;
1093       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
1094    is
1095       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1096       DL : constant Natural := SR.Last + New_Item'Length;
1097       DR : Shared_Wide_Wide_String_Access;
1098
1099    begin
1100       --  Check index first
1101
1102       if Before > SR.Last + 1 then
1103          raise Index_Error;
1104       end if;
1105
1106       --  Result is empty, reuse empty shared string
1107
1108       if DL = 0 then
1109          Reference (Empty_Shared_Wide_Wide_String'Access);
1110          DR := Empty_Shared_Wide_Wide_String'Access;
1111
1112       --  Inserted string is empty, reuse source shared string
1113
1114       elsif New_Item'Length = 0 then
1115          Reference (SR);
1116          DR := SR;
1117
1118       --  Otherwise, allocate new shared string and fill it
1119
1120       else
1121          DR := Allocate (DL + DL / Growth_Factor);
1122          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1123          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1124          DR.Data (Before + New_Item'Length .. DL) :=
1125            SR.Data (Before .. SR.Last);
1126          DR.Last := DL;
1127       end if;
1128
1129       return (AF.Controlled with Reference => DR);
1130    end Insert;
1131
1132    procedure Insert
1133      (Source   : in out Unbounded_Wide_Wide_String;
1134       Before   : Positive;
1135       New_Item : Wide_Wide_String)
1136    is
1137       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1138       DL : constant Natural := SR.Last + New_Item'Length;
1139       DR : Shared_Wide_Wide_String_Access;
1140
1141    begin
1142       --  Check bounds
1143
1144       if Before > SR.Last + 1 then
1145          raise Index_Error;
1146       end if;
1147
1148       --  Result is empty string, reuse empty shared string
1149
1150       if DL = 0 then
1151          Reference (Empty_Shared_Wide_Wide_String'Access);
1152          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1153          Unreference (SR);
1154
1155       --  Inserted string is empty, nothing to do
1156
1157       elsif New_Item'Length = 0 then
1158          null;
1159
1160       --  Try to reuse existent shared string first
1161
1162       elsif Can_Be_Reused (SR, DL) then
1163          SR.Data (Before + New_Item'Length .. DL) :=
1164            SR.Data (Before .. SR.Last);
1165          SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1166          SR.Last := DL;
1167
1168       --  Otherwise, allocate new shared string and fill it
1169
1170       else
1171          DR := Allocate (DL + DL / Growth_Factor);
1172          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1173          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1174          DR.Data (Before + New_Item'Length .. DL) :=
1175            SR.Data (Before .. SR.Last);
1176          DR.Last := DL;
1177          Source.Reference := DR;
1178          Unreference (SR);
1179       end if;
1180    end Insert;
1181
1182    ------------
1183    -- Length --
1184    ------------
1185
1186    function Length (Source : Unbounded_Wide_Wide_String) return Natural is
1187    begin
1188       return Source.Reference.Last;
1189    end Length;
1190
1191    ---------------
1192    -- Overwrite --
1193    ---------------
1194
1195    function Overwrite
1196      (Source   : Unbounded_Wide_Wide_String;
1197       Position : Positive;
1198       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
1199    is
1200       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1201       DL : Natural;
1202       DR : Shared_Wide_Wide_String_Access;
1203
1204    begin
1205       --  Check bounds
1206
1207       if Position > SR.Last + 1 then
1208          raise Index_Error;
1209       end if;
1210
1211       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1212
1213       --  Result is empty string, reuse empty shared string
1214
1215       if DL = 0 then
1216          Reference (Empty_Shared_Wide_Wide_String'Access);
1217          DR := Empty_Shared_Wide_Wide_String'Access;
1218
1219       --  Result is same with source string, reuse source shared string
1220
1221       elsif New_Item'Length = 0 then
1222          Reference (SR);
1223          DR := SR;
1224
1225       --  Otherwise, allocate new shared string and fill it
1226
1227       else
1228          DR := Allocate (DL);
1229          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1230          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1231          DR.Data (Position + New_Item'Length .. DL) :=
1232            SR.Data (Position + New_Item'Length .. SR.Last);
1233          DR.Last := DL;
1234       end if;
1235
1236       return (AF.Controlled with Reference => DR);
1237    end Overwrite;
1238
1239    procedure Overwrite
1240      (Source    : in out Unbounded_Wide_Wide_String;
1241       Position  : Positive;
1242       New_Item  : Wide_Wide_String)
1243    is
1244       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1245       DL : Natural;
1246       DR : Shared_Wide_Wide_String_Access;
1247
1248    begin
1249       --  Bounds check
1250
1251       if Position > SR.Last + 1 then
1252          raise Index_Error;
1253       end if;
1254
1255       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1256
1257       --  Result is empty string, reuse empty shared string
1258
1259       if DL = 0 then
1260          Reference (Empty_Shared_Wide_Wide_String'Access);
1261          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1262          Unreference (SR);
1263
1264       --  String unchanged, nothing to do
1265
1266       elsif New_Item'Length = 0 then
1267          null;
1268
1269       --  Try to reuse existent shared string
1270
1271       elsif Can_Be_Reused (SR, DL) then
1272          SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1273          SR.Last := DL;
1274
1275       --  Otherwise allocate new shared string and fill it
1276
1277       else
1278          DR := Allocate (DL);
1279          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1280          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1281          DR.Data (Position + New_Item'Length .. DL) :=
1282            SR.Data (Position + New_Item'Length .. SR.Last);
1283          DR.Last := DL;
1284          Source.Reference := DR;
1285          Unreference (SR);
1286       end if;
1287    end Overwrite;
1288
1289    ---------------
1290    -- Reference --
1291    ---------------
1292
1293    procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
1294    begin
1295       System.Atomic_Counters.Increment (Item.Counter);
1296    end Reference;
1297
1298    ---------------------
1299    -- Replace_Element --
1300    ---------------------
1301
1302    procedure Replace_Element
1303      (Source : in out Unbounded_Wide_Wide_String;
1304       Index  : Positive;
1305       By     : Wide_Wide_Character)
1306    is
1307       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1308       DR : Shared_Wide_Wide_String_Access;
1309
1310    begin
1311       --  Bounds check
1312
1313       if Index <= SR.Last then
1314
1315          --  Try to reuse existent shared string
1316
1317          if Can_Be_Reused (SR, SR.Last) then
1318             SR.Data (Index) := By;
1319
1320          --  Otherwise allocate new shared string and fill it
1321
1322          else
1323             DR := Allocate (SR.Last);
1324             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1325             DR.Data (Index) := By;
1326             DR.Last := SR.Last;
1327             Source.Reference := DR;
1328             Unreference (SR);
1329          end if;
1330
1331       else
1332          raise Index_Error;
1333       end if;
1334    end Replace_Element;
1335
1336    -------------------
1337    -- Replace_Slice --
1338    -------------------
1339
1340    function Replace_Slice
1341      (Source : Unbounded_Wide_Wide_String;
1342       Low    : Positive;
1343       High   : Natural;
1344       By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
1345    is
1346       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1347       DL : Natural;
1348       DR : Shared_Wide_Wide_String_Access;
1349
1350    begin
1351       --  Check bounds
1352
1353       if Low > SR.Last + 1 then
1354          raise Index_Error;
1355       end if;
1356
1357       --  Do replace operation when removed slice is not empty
1358
1359       if High >= Low then
1360          DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1361          --  This is the number of characters remaining in the string after
1362          --  replacing the slice.
1363
1364          --  Result is empty string, reuse empty shared string
1365
1366          if DL = 0 then
1367             Reference (Empty_Shared_Wide_Wide_String'Access);
1368             DR := Empty_Shared_Wide_Wide_String'Access;
1369
1370          --  Otherwise allocate new shared string and fill it
1371
1372          else
1373             DR := Allocate (DL);
1374             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1375             DR.Data (Low .. Low + By'Length - 1) := By;
1376             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1377             DR.Last := DL;
1378          end if;
1379
1380          return (AF.Controlled with Reference => DR);
1381
1382       --  Otherwise just insert string
1383
1384       else
1385          return Insert (Source, Low, By);
1386       end if;
1387    end Replace_Slice;
1388
1389    procedure Replace_Slice
1390      (Source : in out Unbounded_Wide_Wide_String;
1391       Low    : Positive;
1392       High   : Natural;
1393       By     : Wide_Wide_String)
1394    is
1395       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1396       DL : Natural;
1397       DR : Shared_Wide_Wide_String_Access;
1398
1399    begin
1400       --  Bounds check
1401
1402       if Low > SR.Last + 1 then
1403          raise Index_Error;
1404       end if;
1405
1406       --  Do replace operation only when replaced slice is not empty
1407
1408       if High >= Low then
1409          DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1410          --  This is the number of characters remaining in the string after
1411          --  replacing the slice.
1412
1413          --  Result is empty string, reuse empty shared string
1414
1415          if DL = 0 then
1416             Reference (Empty_Shared_Wide_Wide_String'Access);
1417             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1418             Unreference (SR);
1419
1420          --  Try to reuse existent shared string
1421
1422          elsif Can_Be_Reused (SR, DL) then
1423             SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1424             SR.Data (Low .. Low + By'Length - 1) := By;
1425             SR.Last := DL;
1426
1427          --  Otherwise allocate new shared string and fill it
1428
1429          else
1430             DR := Allocate (DL);
1431             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1432             DR.Data (Low .. Low + By'Length - 1) := By;
1433             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1434             DR.Last := DL;
1435             Source.Reference := DR;
1436             Unreference (SR);
1437          end if;
1438
1439       --  Otherwise just insert item
1440
1441       else
1442          Insert (Source, Low, By);
1443       end if;
1444    end Replace_Slice;
1445
1446    -------------------------------
1447    -- Set_Unbounded_Wide_Wide_String --
1448    -------------------------------
1449
1450    procedure Set_Unbounded_Wide_Wide_String
1451      (Target : out Unbounded_Wide_Wide_String;
1452       Source : Wide_Wide_String)
1453    is
1454       TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
1455       DR : Shared_Wide_Wide_String_Access;
1456
1457    begin
1458       --  In case of empty string, reuse empty shared string
1459
1460       if Source'Length = 0 then
1461          Reference (Empty_Shared_Wide_Wide_String'Access);
1462          Target.Reference := Empty_Shared_Wide_Wide_String'Access;
1463
1464       else
1465          --  Try to reuse existent shared string
1466
1467          if Can_Be_Reused (TR, Source'Length) then
1468             Reference (TR);
1469             DR := TR;
1470
1471          --  Otherwise allocate new shared string
1472
1473          else
1474             DR := Allocate (Source'Length);
1475             Target.Reference := DR;
1476          end if;
1477
1478          DR.Data (1 .. Source'Length) := Source;
1479          DR.Last := Source'Length;
1480       end if;
1481
1482       Unreference (TR);
1483    end Set_Unbounded_Wide_Wide_String;
1484
1485    -----------
1486    -- Slice --
1487    -----------
1488
1489    function Slice
1490      (Source : Unbounded_Wide_Wide_String;
1491       Low    : Positive;
1492       High   : Natural) return Wide_Wide_String
1493    is
1494       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1495
1496    begin
1497       --  Note: test of High > Length is in accordance with AI95-00128
1498
1499       if Low > SR.Last + 1 or else High > SR.Last then
1500          raise Index_Error;
1501
1502       else
1503          return SR.Data (Low .. High);
1504       end if;
1505    end Slice;
1506
1507    ----------
1508    -- Tail --
1509    ----------
1510
1511    function Tail
1512      (Source : Unbounded_Wide_Wide_String;
1513       Count  : Natural;
1514       Pad    : Wide_Wide_Character := Wide_Wide_Space)
1515       return Unbounded_Wide_Wide_String
1516    is
1517       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1518       DR : Shared_Wide_Wide_String_Access;
1519
1520    begin
1521       --  For empty result reuse empty shared string
1522
1523       if Count = 0 then
1524          Reference (Empty_Shared_Wide_Wide_String'Access);
1525          DR := Empty_Shared_Wide_Wide_String'Access;
1526
1527       --  Result is hole source string, reuse source shared string
1528
1529       elsif Count = SR.Last then
1530          Reference (SR);
1531          DR := SR;
1532
1533       --  Otherwise allocate new shared string and fill it
1534
1535       else
1536          DR := Allocate (Count);
1537
1538          if Count < SR.Last then
1539             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1540
1541          else
1542             for J in 1 .. Count - SR.Last loop
1543                DR.Data (J) := Pad;
1544             end loop;
1545
1546             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1547          end if;
1548
1549          DR.Last := Count;
1550       end if;
1551
1552       return (AF.Controlled with Reference => DR);
1553    end Tail;
1554
1555    procedure Tail
1556      (Source : in out Unbounded_Wide_Wide_String;
1557       Count  : Natural;
1558       Pad    : Wide_Wide_Character := Wide_Wide_Space)
1559    is
1560       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1561       DR : Shared_Wide_Wide_String_Access;
1562
1563       procedure Common
1564         (SR    : Shared_Wide_Wide_String_Access;
1565          DR    : Shared_Wide_Wide_String_Access;
1566          Count : Natural);
1567       --  Common code of tail computation. SR/DR can point to the same object
1568
1569       ------------
1570       -- Common --
1571       ------------
1572
1573       procedure Common
1574         (SR    : Shared_Wide_Wide_String_Access;
1575          DR    : Shared_Wide_Wide_String_Access;
1576          Count : Natural) is
1577       begin
1578          if Count < SR.Last then
1579             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1580
1581          else
1582             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1583
1584             for J in 1 .. Count - SR.Last loop
1585                DR.Data (J) := Pad;
1586             end loop;
1587          end if;
1588
1589          DR.Last := Count;
1590       end Common;
1591
1592    begin
1593       --  Result is empty string, reuse empty shared string
1594
1595       if Count = 0 then
1596          Reference (Empty_Shared_Wide_Wide_String'Access);
1597          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1598          Unreference (SR);
1599
1600       --  Length of the result is the same with length of the source string,
1601       --  reuse source shared string.
1602
1603       elsif Count = SR.Last then
1604          null;
1605
1606       --  Try to reuse existent shared string
1607
1608       elsif Can_Be_Reused (SR, Count) then
1609          Common (SR, SR, Count);
1610
1611       --  Otherwise allocate new shared string and fill it
1612
1613       else
1614          DR := Allocate (Count);
1615          Common (SR, DR, Count);
1616          Source.Reference := DR;
1617          Unreference (SR);
1618       end if;
1619    end Tail;
1620
1621    --------------------
1622    -- To_Wide_Wide_String --
1623    --------------------
1624
1625    function To_Wide_Wide_String
1626      (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is
1627    begin
1628       return Source.Reference.Data (1 .. Source.Reference.Last);
1629    end To_Wide_Wide_String;
1630
1631    ------------------------------
1632    -- To_Unbounded_Wide_Wide_String --
1633    ------------------------------
1634
1635    function To_Unbounded_Wide_Wide_String
1636      (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
1637    is
1638       DR : constant Shared_Wide_Wide_String_Access := Allocate (Source'Length);
1639    begin
1640       DR.Data (1 .. Source'Length) := Source;
1641       DR.Last := Source'Length;
1642       return (AF.Controlled with Reference => DR);
1643    end To_Unbounded_Wide_Wide_String;
1644
1645    function To_Unbounded_Wide_Wide_String
1646      (Length : Natural) return Unbounded_Wide_Wide_String
1647    is
1648       DR : constant Shared_Wide_Wide_String_Access := Allocate (Length);
1649    begin
1650       DR.Last := Length;
1651       return (AF.Controlled with Reference => DR);
1652    end To_Unbounded_Wide_Wide_String;
1653
1654    ---------------
1655    -- Translate --
1656    ---------------
1657
1658    function Translate
1659      (Source  : Unbounded_Wide_Wide_String;
1660       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1661       return Unbounded_Wide_Wide_String
1662    is
1663       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1664       DR : Shared_Wide_Wide_String_Access;
1665
1666    begin
1667       --  Nothing to translate, reuse empty shared string
1668
1669       if SR.Last = 0 then
1670          Reference (Empty_Shared_Wide_Wide_String'Access);
1671          DR := Empty_Shared_Wide_Wide_String'Access;
1672
1673       --  Otherwise, allocate new shared string and fill it
1674
1675       else
1676          DR := Allocate (SR.Last);
1677
1678          for J in 1 .. SR.Last loop
1679             DR.Data (J) := Value (Mapping, SR.Data (J));
1680          end loop;
1681
1682          DR.Last := SR.Last;
1683       end if;
1684
1685       return (AF.Controlled with Reference => DR);
1686    end Translate;
1687
1688    procedure Translate
1689      (Source  : in out Unbounded_Wide_Wide_String;
1690       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1691    is
1692       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1693       DR : Shared_Wide_Wide_String_Access;
1694
1695    begin
1696       --  Nothing to translate
1697
1698       if SR.Last = 0 then
1699          null;
1700
1701       --  Try to reuse shared string
1702
1703       elsif Can_Be_Reused (SR, SR.Last) then
1704          for J in 1 .. SR.Last loop
1705             SR.Data (J) := Value (Mapping, SR.Data (J));
1706          end loop;
1707
1708       --  Otherwise, allocate new shared string
1709
1710       else
1711          DR := Allocate (SR.Last);
1712
1713          for J in 1 .. SR.Last loop
1714             DR.Data (J) := Value (Mapping, SR.Data (J));
1715          end loop;
1716
1717          DR.Last := SR.Last;
1718          Source.Reference := DR;
1719          Unreference (SR);
1720       end if;
1721    end Translate;
1722
1723    function Translate
1724      (Source  : Unbounded_Wide_Wide_String;
1725       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1726       return Unbounded_Wide_Wide_String
1727    is
1728       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1729       DR : Shared_Wide_Wide_String_Access;
1730
1731    begin
1732       --  Nothing to translate, reuse empty shared string
1733
1734       if SR.Last = 0 then
1735          Reference (Empty_Shared_Wide_Wide_String'Access);
1736          DR := Empty_Shared_Wide_Wide_String'Access;
1737
1738       --  Otherwise, allocate new shared string and fill it
1739
1740       else
1741          DR := Allocate (SR.Last);
1742
1743          for J in 1 .. SR.Last loop
1744             DR.Data (J) := Mapping.all (SR.Data (J));
1745          end loop;
1746
1747          DR.Last := SR.Last;
1748       end if;
1749
1750       return (AF.Controlled with Reference => DR);
1751
1752    exception
1753       when others =>
1754          Unreference (DR);
1755
1756          raise;
1757    end Translate;
1758
1759    procedure Translate
1760      (Source  : in out Unbounded_Wide_Wide_String;
1761       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1762    is
1763       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1764       DR : Shared_Wide_Wide_String_Access;
1765
1766    begin
1767       --  Nothing to translate
1768
1769       if SR.Last = 0 then
1770          null;
1771
1772       --  Try to reuse shared string
1773
1774       elsif Can_Be_Reused (SR, SR.Last) then
1775          for J in 1 .. SR.Last loop
1776             SR.Data (J) := Mapping.all (SR.Data (J));
1777          end loop;
1778
1779       --  Otherwise allocate new shared string and fill it
1780
1781       else
1782          DR := Allocate (SR.Last);
1783
1784          for J in 1 .. SR.Last loop
1785             DR.Data (J) := Mapping.all (SR.Data (J));
1786          end loop;
1787
1788          DR.Last := SR.Last;
1789          Source.Reference := DR;
1790          Unreference (SR);
1791       end if;
1792
1793    exception
1794       when others =>
1795          if DR /= null then
1796             Unreference (DR);
1797          end if;
1798
1799          raise;
1800    end Translate;
1801
1802    ----------
1803    -- Trim --
1804    ----------
1805
1806    function Trim
1807      (Source : Unbounded_Wide_Wide_String;
1808       Side   : Trim_End) return Unbounded_Wide_Wide_String
1809    is
1810       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1811       DL   : Natural;
1812       DR   : Shared_Wide_Wide_String_Access;
1813       Low  : Natural;
1814       High : Natural;
1815
1816    begin
1817       Low := Index_Non_Blank (Source, Forward);
1818
1819       --  All blanks, reuse empty shared string
1820
1821       if Low = 0 then
1822          Reference (Empty_Shared_Wide_Wide_String'Access);
1823          DR := Empty_Shared_Wide_Wide_String'Access;
1824
1825       else
1826          case Side is
1827             when Left =>
1828                High := SR.Last;
1829                DL   := SR.Last - Low + 1;
1830
1831             when Right =>
1832                Low  := 1;
1833                High := Index_Non_Blank (Source, Backward);
1834                DL   := High;
1835
1836             when Both =>
1837                High := Index_Non_Blank (Source, Backward);
1838                DL   := High - Low + 1;
1839          end case;
1840
1841          --  Length of the result is the same as length of the source string,
1842          --  reuse source shared string.
1843
1844          if DL = SR.Last then
1845             Reference (SR);
1846             DR := SR;
1847
1848          --  Otherwise, allocate new shared string
1849
1850          else
1851             DR := Allocate (DL);
1852             DR.Data (1 .. DL) := SR.Data (Low .. High);
1853             DR.Last := DL;
1854          end if;
1855       end if;
1856
1857       return (AF.Controlled with Reference => DR);
1858    end Trim;
1859
1860    procedure Trim
1861      (Source : in out Unbounded_Wide_Wide_String;
1862       Side   : Trim_End)
1863    is
1864       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1865       DL   : Natural;
1866       DR   : Shared_Wide_Wide_String_Access;
1867       Low  : Natural;
1868       High : Natural;
1869
1870    begin
1871       Low := Index_Non_Blank (Source, Forward);
1872
1873       --  All blanks, reuse empty shared string
1874
1875       if Low = 0 then
1876          Reference (Empty_Shared_Wide_Wide_String'Access);
1877          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1878          Unreference (SR);
1879
1880       else
1881          case Side is
1882             when Left =>
1883                High := SR.Last;
1884                DL   := SR.Last - Low + 1;
1885
1886             when Right =>
1887                Low  := 1;
1888                High := Index_Non_Blank (Source, Backward);
1889                DL   := High;
1890
1891             when Both =>
1892                High := Index_Non_Blank (Source, Backward);
1893                DL   := High - Low + 1;
1894          end case;
1895
1896          --  Length of the result is the same as length of the source string,
1897          --  nothing to do.
1898
1899          if DL = SR.Last then
1900             null;
1901
1902          --  Try to reuse existent shared string
1903
1904          elsif Can_Be_Reused (SR, DL) then
1905             SR.Data (1 .. DL) := SR.Data (Low .. High);
1906             SR.Last := DL;
1907
1908          --  Otherwise, allocate new shared string
1909
1910          else
1911             DR := Allocate (DL);
1912             DR.Data (1 .. DL) := SR.Data (Low .. High);
1913             DR.Last := DL;
1914             Source.Reference := DR;
1915             Unreference (SR);
1916          end if;
1917       end if;
1918    end Trim;
1919
1920    function Trim
1921      (Source : Unbounded_Wide_Wide_String;
1922       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1923       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1924       return Unbounded_Wide_Wide_String
1925    is
1926       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1927       DL   : Natural;
1928       DR   : Shared_Wide_Wide_String_Access;
1929       Low  : Natural;
1930       High : Natural;
1931
1932    begin
1933       Low := Index (Source, Left, Outside, Forward);
1934
1935       --  Source includes only characters from Left set, reuse empty shared
1936       --  string.
1937
1938       if Low = 0 then
1939          Reference (Empty_Shared_Wide_Wide_String'Access);
1940          DR := Empty_Shared_Wide_Wide_String'Access;
1941
1942       else
1943          High := Index (Source, Right, Outside, Backward);
1944          DL   := Integer'Max (0, High - Low + 1);
1945
1946          --  Source includes only characters from Right set or result string
1947          --  is empty, reuse empty shared string.
1948
1949          if High = 0 or else DL = 0 then
1950             Reference (Empty_Shared_Wide_Wide_String'Access);
1951             DR := Empty_Shared_Wide_Wide_String'Access;
1952
1953          --  Otherwise, allocate new shared string and fill it
1954
1955          else
1956             DR := Allocate (DL);
1957             DR.Data (1 .. DL) := SR.Data (Low .. High);
1958             DR.Last := DL;
1959          end if;
1960       end if;
1961
1962       return (AF.Controlled with Reference => DR);
1963    end Trim;
1964
1965    procedure Trim
1966      (Source : in out Unbounded_Wide_Wide_String;
1967       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1968       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1969    is
1970       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1971       DL   : Natural;
1972       DR   : Shared_Wide_Wide_String_Access;
1973       Low  : Natural;
1974       High : Natural;
1975
1976    begin
1977       Low := Index (Source, Left, Outside, Forward);
1978
1979       --  Source includes only characters from Left set, reuse empty shared
1980       --  string.
1981
1982       if Low = 0 then
1983          Reference (Empty_Shared_Wide_Wide_String'Access);
1984          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1985          Unreference (SR);
1986
1987       else
1988          High := Index (Source, Right, Outside, Backward);
1989          DL   := Integer'Max (0, High - Low + 1);
1990
1991          --  Source includes only characters from Right set or result string
1992          --  is empty, reuse empty shared string.
1993
1994          if High = 0 or else DL = 0 then
1995             Reference (Empty_Shared_Wide_Wide_String'Access);
1996             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1997             Unreference (SR);
1998
1999          --  Try to reuse existent shared string
2000
2001          elsif Can_Be_Reused (SR, DL) then
2002             SR.Data (1 .. DL) := SR.Data (Low .. High);
2003             SR.Last := DL;
2004
2005          --  Otherwise, allocate new shared string and fill it
2006
2007          else
2008             DR := Allocate (DL);
2009             DR.Data (1 .. DL) := SR.Data (Low .. High);
2010             DR.Last := DL;
2011             Source.Reference := DR;
2012             Unreference (SR);
2013          end if;
2014       end if;
2015    end Trim;
2016
2017    ---------------------
2018    -- Unbounded_Slice --
2019    ---------------------
2020
2021    function Unbounded_Slice
2022      (Source : Unbounded_Wide_Wide_String;
2023       Low    : Positive;
2024       High   : Natural) return Unbounded_Wide_Wide_String
2025    is
2026       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
2027       DL : Natural;
2028       DR : Shared_Wide_Wide_String_Access;
2029
2030    begin
2031       --  Check bounds
2032
2033       if Low > SR.Last + 1 or else High > SR.Last then
2034          raise Index_Error;
2035
2036       --  Result is empty slice, reuse empty shared string
2037
2038       elsif Low > High then
2039          Reference (Empty_Shared_Wide_Wide_String'Access);
2040          DR := Empty_Shared_Wide_Wide_String'Access;
2041
2042       --  Otherwise, allocate new shared string and fill it
2043
2044       else
2045          DL := High - Low + 1;
2046          DR := Allocate (DL);
2047          DR.Data (1 .. DL) := SR.Data (Low .. High);
2048          DR.Last := DL;
2049       end if;
2050
2051       return (AF.Controlled with Reference => DR);
2052    end Unbounded_Slice;
2053
2054    procedure Unbounded_Slice
2055      (Source : Unbounded_Wide_Wide_String;
2056       Target : out Unbounded_Wide_Wide_String;
2057       Low    : Positive;
2058       High   : Natural)
2059    is
2060       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
2061       TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
2062       DL : Natural;
2063       DR : Shared_Wide_Wide_String_Access;
2064
2065    begin
2066       --  Check bounds
2067
2068       if Low > SR.Last + 1 or else High > SR.Last then
2069          raise Index_Error;
2070
2071       --  Result is empty slice, reuse empty shared string
2072
2073       elsif Low > High then
2074          Reference (Empty_Shared_Wide_Wide_String'Access);
2075          Target.Reference := Empty_Shared_Wide_Wide_String'Access;
2076          Unreference (TR);
2077
2078       else
2079          DL := High - Low + 1;
2080
2081          --  Try to reuse existent shared string
2082
2083          if Can_Be_Reused (TR, DL) then
2084             TR.Data (1 .. DL) := SR.Data (Low .. High);
2085             TR.Last := DL;
2086
2087          --  Otherwise, allocate new shared string and fill it
2088
2089          else
2090             DR := Allocate (DL);
2091             DR.Data (1 .. DL) := SR.Data (Low .. High);
2092             DR.Last := DL;
2093             Target.Reference := DR;
2094             Unreference (TR);
2095          end if;
2096       end if;
2097    end Unbounded_Slice;
2098
2099    -----------------
2100    -- Unreference --
2101    -----------------
2102
2103    procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
2104
2105       procedure Free is
2106         new Ada.Unchecked_Deallocation
2107               (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access);
2108
2109       Aux : Shared_Wide_Wide_String_Access := Item;
2110
2111    begin
2112       if System.Atomic_Counters.Decrement (Aux.Counter) then
2113
2114          --  Reference counter of Empty_Shared_Wide_Wide_String must never
2115          --  reach zero.
2116
2117          pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access);
2118
2119          Free (Aux);
2120       end if;
2121    end Unreference;
2122
2123 end Ada.Strings.Wide_Wide_Unbounded;