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-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- 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 (DL);
  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 / Standard'Storage_Unit;
 490       --  Total size of all static components
 491
 492       Element_Size : constant Natural :=
 493         Wide_Wide_Character'Size / Standard'Storage_Unit;
 494
 495    begin
 496       return
 497         (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
 498           * Min_Mul_Alloc - Static_Size) / Element_Size;
 499    end Aligned_Max_Length;
 500
 501    --------------
 502    -- Allocate --
 503    --------------
 504
 505    function Allocate
 506      (Max_Length : Natural) return Shared_Wide_Wide_String_Access is
 507    begin
 508       --  Empty string requested, return shared empty string
 509
 510       if Max_Length = 0 then
 511          Reference (Empty_Shared_Wide_Wide_String'Access);
 512          return Empty_Shared_Wide_Wide_String'Access;
 513
 514       --  Otherwise, allocate requested space (and probably some more room)
 515
 516       else
 517          return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length));
 518       end if;
 519    end Allocate;
 520
 521    ------------
 522    -- Append --
 523    ------------
 524
 525    procedure Append
 526      (Source   : in out Unbounded_Wide_Wide_String;
 527       New_Item : Unbounded_Wide_Wide_String)
 528    is
 529       SR  : constant Shared_Wide_Wide_String_Access := Source.Reference;
 530       NR  : constant Shared_Wide_Wide_String_Access := New_Item.Reference;
 531       DL  : constant Natural              := SR.Last + NR.Last;
 532       DR  : Shared_Wide_Wide_String_Access;
 533
 534    begin
 535       --  Source is an empty string, reuse New_Item data
 536
 537       if SR.Last = 0 then
 538          Reference (NR);
 539          Source.Reference := NR;
 540          Unreference (SR);
 541
 542       --  New_Item is empty string, nothing to do
 543
 544       elsif NR.Last = 0 then
 545          null;
 546
 547       --  Try to reuse existent shared string
 548
 549       elsif Can_Be_Reused (SR, DL) then
 550          SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 551          SR.Last := DL;
 552
 553       --  Otherwise, allocate new one and fill it
 554
 555       else
 556          DR := Allocate (DL + DL / Growth_Factor);
 557          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 558          DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
 559          DR.Last := DL;
 560          Source.Reference := DR;
 561          Unreference (SR);
 562       end if;
 563    end Append;
 564
 565    procedure Append
 566      (Source   : in out Unbounded_Wide_Wide_String;
 567       New_Item : Wide_Wide_String)
 568    is
 569       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 570       DL : constant Natural := SR.Last + New_Item'Length;
 571       DR : Shared_Wide_Wide_String_Access;
 572
 573    begin
 574       --  New_Item is an empty string, nothing to do
 575
 576       if New_Item'Length = 0 then
 577          null;
 578
 579       --  Try to reuse existing shared string
 580
 581       elsif Can_Be_Reused (SR, DL) then
 582          SR.Data (SR.Last + 1 .. DL) := New_Item;
 583          SR.Last := DL;
 584
 585       --  Otherwise, allocate new one and fill it
 586
 587       else
 588          DR := Allocate (DL + DL / Growth_Factor);
 589          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 590          DR.Data (SR.Last + 1 .. DL) := New_Item;
 591          DR.Last := DL;
 592          Source.Reference := DR;
 593          Unreference (SR);
 594       end if;
 595    end Append;
 596
 597    procedure Append
 598      (Source   : in out Unbounded_Wide_Wide_String;
 599       New_Item : Wide_Wide_Character)
 600    is
 601       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 602       DL : constant Natural := SR.Last + 1;
 603       DR : Shared_Wide_Wide_String_Access;
 604
 605    begin
 606       --  Try to reuse existing shared string
 607
 608       if Can_Be_Reused (SR, SR.Last + 1) then
 609          SR.Data (SR.Last + 1) := New_Item;
 610          SR.Last := SR.Last + 1;
 611
 612       --  Otherwise, allocate new one and fill it
 613
 614       else
 615          DR := Allocate (DL + DL / Growth_Factor);
 616          DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 617          DR.Data (DL) := New_Item;
 618          DR.Last := DL;
 619          Source.Reference := DR;
 620          Unreference (SR);
 621       end if;
 622    end Append;
 623
 624    -------------------
 625    -- Can_Be_Reused --
 626    -------------------
 627
 628    function Can_Be_Reused
 629      (Item   : Shared_Wide_Wide_String_Access;
 630       Length : Natural) return Boolean is
 631    begin
 632       return
 633         System.Atomic_Counters.Is_One (Item.Counter)
 634           and then Item.Max_Length >= Length
 635           and then Item.Max_Length <=
 636                      Aligned_Max_Length (Length + Length / Growth_Factor);
 637    end Can_Be_Reused;
 638
 639    -----------
 640    -- Count --
 641    -----------
 642
 643    function Count
 644      (Source  : Unbounded_Wide_Wide_String;
 645       Pattern : Wide_Wide_String;
 646       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 647         Wide_Wide_Maps.Identity) return Natural
 648    is
 649       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 650    begin
 651       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 652    end Count;
 653
 654    function Count
 655      (Source  : Unbounded_Wide_Wide_String;
 656       Pattern : Wide_Wide_String;
 657       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 658       return Natural
 659    is
 660       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 661    begin
 662       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
 663    end Count;
 664
 665    function Count
 666      (Source : Unbounded_Wide_Wide_String;
 667       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 668    is
 669       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 670    begin
 671       return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
 672    end Count;
 673
 674    ------------
 675    -- Delete --
 676    ------------
 677
 678    function Delete
 679      (Source  : Unbounded_Wide_Wide_String;
 680       From    : Positive;
 681       Through : Natural) return Unbounded_Wide_Wide_String
 682    is
 683       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 684       DL : Natural;
 685       DR : Shared_Wide_Wide_String_Access;
 686
 687    begin
 688       --  Empty slice is deleted, use the same shared string
 689
 690       if From > Through then
 691          Reference (SR);
 692          DR := SR;
 693
 694       --  Index is out of range
 695
 696       elsif Through > SR.Last then
 697          raise Index_Error;
 698
 699       --  Compute size of the result
 700
 701       else
 702          DL := SR.Last - (Through - From + 1);
 703
 704          --  Result is an empty string, reuse shared empty string
 705
 706          if DL = 0 then
 707             Reference (Empty_Shared_Wide_Wide_String'Access);
 708             DR := Empty_Shared_Wide_Wide_String'Access;
 709
 710          --  Otherwise, allocate new shared string and fill it
 711
 712          else
 713             DR := Allocate (DL);
 714             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 715             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 716             DR.Last := DL;
 717          end if;
 718       end if;
 719
 720       return (AF.Controlled with Reference => DR);
 721    end Delete;
 722
 723    procedure Delete
 724      (Source  : in out Unbounded_Wide_Wide_String;
 725       From    : Positive;
 726       Through : Natural)
 727    is
 728       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 729       DL : Natural;
 730       DR : Shared_Wide_Wide_String_Access;
 731
 732    begin
 733       --  Nothing changed, return
 734
 735       if From > Through then
 736          null;
 737
 738       --  Through is outside of the range
 739
 740       elsif Through > SR.Last then
 741          raise Index_Error;
 742
 743       else
 744          DL := SR.Last - (Through - From + 1);
 745
 746          --  Result is empty, reuse shared empty string
 747
 748          if DL = 0 then
 749             Reference (Empty_Shared_Wide_Wide_String'Access);
 750             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
 751             Unreference (SR);
 752
 753          --  Try to reuse existent shared string
 754
 755          elsif Can_Be_Reused (SR, DL) then
 756             SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 757             SR.Last := DL;
 758
 759          --  Otherwise, allocate new shared string
 760
 761          else
 762             DR := Allocate (DL);
 763             DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
 764             DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
 765             DR.Last := DL;
 766             Source.Reference := DR;
 767             Unreference (SR);
 768          end if;
 769       end if;
 770    end Delete;
 771
 772    -------------
 773    -- Element --
 774    -------------
 775
 776    function Element
 777      (Source : Unbounded_Wide_Wide_String;
 778       Index  : Positive) return Wide_Wide_Character
 779    is
 780       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 781    begin
 782       if Index <= SR.Last then
 783          return SR.Data (Index);
 784       else
 785          raise Index_Error;
 786       end if;
 787    end Element;
 788
 789    --------------
 790    -- Finalize --
 791    --------------
 792
 793    procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
 794       SR : constant Shared_Wide_Wide_String_Access := Object.Reference;
 795
 796    begin
 797       if SR /= null then
 798
 799          --  The same controlled object can be finalized several times for
 800          --  some reason. As per 7.6.1(24) this should have no ill effect,
 801          --  so we need to add a guard for the case of finalizing the same
 802          --  object twice.
 803
 804          Object.Reference := null;
 805          Unreference (SR);
 806       end if;
 807    end Finalize;
 808
 809    ----------------
 810    -- Find_Token --
 811    ----------------
 812
 813    procedure Find_Token
 814      (Source : Unbounded_Wide_Wide_String;
 815       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 816       From   : Positive;
 817       Test   : Strings.Membership;
 818       First  : out Positive;
 819       Last   : out Natural)
 820    is
 821       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 822    begin
 823       Wide_Wide_Search.Find_Token
 824         (SR.Data (From .. SR.Last), Set, Test, First, Last);
 825    end Find_Token;
 826
 827    procedure Find_Token
 828      (Source : Unbounded_Wide_Wide_String;
 829       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 830       Test   : Strings.Membership;
 831       First  : out Positive;
 832       Last   : out Natural)
 833    is
 834       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 835    begin
 836       Wide_Wide_Search.Find_Token
 837         (SR.Data (1 .. SR.Last), Set, Test, First, Last);
 838    end Find_Token;
 839
 840    ----------
 841    -- Free --
 842    ----------
 843
 844    procedure Free (X : in out Wide_Wide_String_Access) is
 845       procedure Deallocate is
 846          new Ada.Unchecked_Deallocation
 847                (Wide_Wide_String, Wide_Wide_String_Access);
 848    begin
 849       Deallocate (X);
 850    end Free;
 851
 852    ----------
 853    -- Head --
 854    ----------
 855
 856    function Head
 857      (Source : Unbounded_Wide_Wide_String;
 858       Count  : Natural;
 859       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 860       return Unbounded_Wide_Wide_String
 861    is
 862       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 863       DR : Shared_Wide_Wide_String_Access;
 864
 865    begin
 866       --  Result is empty, reuse shared empty string
 867
 868       if Count = 0 then
 869          Reference (Empty_Shared_Wide_Wide_String'Access);
 870          DR := Empty_Shared_Wide_Wide_String'Access;
 871
 872       --  Length of the string is the same as requested, reuse source shared
 873       --  string.
 874
 875       elsif Count = SR.Last then
 876          Reference (SR);
 877          DR := SR;
 878
 879       --  Otherwise, allocate new shared string and fill it
 880
 881       else
 882          DR := Allocate (Count);
 883
 884          --  Length of the source string is more than requested, copy
 885          --  corresponding slice.
 886
 887          if Count < SR.Last then
 888             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 889
 890          --  Length of the source string is less than requested, copy all
 891          --  contents and fill others by Pad character.
 892
 893          else
 894             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 895
 896             for J in SR.Last + 1 .. Count loop
 897                DR.Data (J) := Pad;
 898             end loop;
 899          end if;
 900
 901          DR.Last := Count;
 902       end if;
 903
 904       return (AF.Controlled with Reference => DR);
 905    end Head;
 906
 907    procedure Head
 908      (Source : in out Unbounded_Wide_Wide_String;
 909       Count  : Natural;
 910       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 911    is
 912       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 913       DR : Shared_Wide_Wide_String_Access;
 914
 915    begin
 916       --  Result is empty, reuse empty shared string
 917
 918       if Count = 0 then
 919          Reference (Empty_Shared_Wide_Wide_String'Access);
 920          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
 921          Unreference (SR);
 922
 923       --  Result is same with source string, reuse source shared string
 924
 925       elsif Count = SR.Last then
 926          null;
 927
 928       --  Try to reuse existent shared string
 929
 930       elsif Can_Be_Reused (SR, Count) then
 931          if Count > SR.Last then
 932             for J in SR.Last + 1 .. Count loop
 933                SR.Data (J) := Pad;
 934             end loop;
 935          end if;
 936
 937          SR.Last := Count;
 938
 939       --  Otherwise, allocate new shared string and fill it
 940
 941       else
 942          DR := Allocate (Count);
 943
 944          --  Length of the source string is greater than requested, copy
 945          --  corresponding slice.
 946
 947          if Count < SR.Last then
 948             DR.Data (1 .. Count) := SR.Data (1 .. Count);
 949
 950          --  Length of the source string is less than requested, copy all
 951          --  exists data and fill others by Pad character.
 952
 953          else
 954             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
 955
 956             for J in SR.Last + 1 .. Count loop
 957                DR.Data (J) := Pad;
 958             end loop;
 959          end if;
 960
 961          DR.Last := Count;
 962          Source.Reference := DR;
 963          Unreference (SR);
 964       end if;
 965    end Head;
 966
 967    -----------
 968    -- Index --
 969    -----------
 970
 971    function Index
 972      (Source  : Unbounded_Wide_Wide_String;
 973       Pattern : Wide_Wide_String;
 974       Going   : Strings.Direction := Strings.Forward;
 975       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 976         Wide_Wide_Maps.Identity) return Natural
 977    is
 978       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 979    begin
 980       return Wide_Wide_Search.Index
 981         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 982    end Index;
 983
 984    function Index
 985      (Source  : Unbounded_Wide_Wide_String;
 986       Pattern : Wide_Wide_String;
 987       Going   : Direction := Forward;
 988       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 989       return Natural
 990    is
 991       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
 992    begin
 993       return Wide_Wide_Search.Index
 994         (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
 995    end Index;
 996
 997    function Index
 998      (Source : Unbounded_Wide_Wide_String;
 999       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
1000       Test   : Strings.Membership := Strings.Inside;
1001       Going  : Strings.Direction  := Strings.Forward) return Natural
1002    is
1003       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1004    begin
1005       return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
1006    end Index;
1007
1008    function Index
1009      (Source  : Unbounded_Wide_Wide_String;
1010       Pattern : Wide_Wide_String;
1011       From    : Positive;
1012       Going   : Direction := Forward;
1013       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
1014         Wide_Wide_Maps.Identity) return Natural
1015    is
1016       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1017    begin
1018       return Wide_Wide_Search.Index
1019         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1020    end Index;
1021
1022    function Index
1023      (Source  : Unbounded_Wide_Wide_String;
1024       Pattern : Wide_Wide_String;
1025       From    : Positive;
1026       Going   : Direction := Forward;
1027       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1028       return Natural
1029    is
1030       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1031    begin
1032       return Wide_Wide_Search.Index
1033         (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
1034    end Index;
1035
1036    function Index
1037      (Source  : Unbounded_Wide_Wide_String;
1038       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
1039       From    : Positive;
1040       Test    : Membership := Inside;
1041       Going   : Direction := Forward) return Natural
1042    is
1043       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1044    begin
1045       return Wide_Wide_Search.Index
1046         (SR.Data (1 .. SR.Last), Set, From, Test, Going);
1047    end Index;
1048
1049    ---------------------
1050    -- Index_Non_Blank --
1051    ---------------------
1052
1053    function Index_Non_Blank
1054      (Source : Unbounded_Wide_Wide_String;
1055       Going  : Strings.Direction := Strings.Forward) return Natural
1056    is
1057       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1058    begin
1059       return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
1060    end Index_Non_Blank;
1061
1062    function Index_Non_Blank
1063      (Source : Unbounded_Wide_Wide_String;
1064       From   : Positive;
1065       Going  : Direction := Forward) return Natural
1066    is
1067       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1068    begin
1069       return Wide_Wide_Search.Index_Non_Blank
1070         (SR.Data (1 .. SR.Last), From, Going);
1071    end Index_Non_Blank;
1072
1073    ----------------
1074    -- Initialize --
1075    ----------------
1076
1077    procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
1078    begin
1079       Reference (Object.Reference);
1080    end Initialize;
1081
1082    ------------
1083    -- Insert --
1084    ------------
1085
1086    function Insert
1087      (Source   : Unbounded_Wide_Wide_String;
1088       Before   : Positive;
1089       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
1090    is
1091       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1092       DL : constant Natural := SR.Last + New_Item'Length;
1093       DR : Shared_Wide_Wide_String_Access;
1094
1095    begin
1096       --  Check index first
1097
1098       if Before > SR.Last + 1 then
1099          raise Index_Error;
1100       end if;
1101
1102       --  Result is empty, reuse empty shared string
1103
1104       if DL = 0 then
1105          Reference (Empty_Shared_Wide_Wide_String'Access);
1106          DR := Empty_Shared_Wide_Wide_String'Access;
1107
1108       --  Inserted string is empty, reuse source shared string
1109
1110       elsif New_Item'Length = 0 then
1111          Reference (SR);
1112          DR := SR;
1113
1114       --  Otherwise, allocate new shared string and fill it
1115
1116       else
1117          DR := Allocate (DL + DL / Growth_Factor);
1118          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1119          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1120          DR.Data (Before + New_Item'Length .. DL) :=
1121            SR.Data (Before .. SR.Last);
1122          DR.Last := DL;
1123       end if;
1124
1125       return (AF.Controlled with Reference => DR);
1126    end Insert;
1127
1128    procedure Insert
1129      (Source   : in out Unbounded_Wide_Wide_String;
1130       Before   : Positive;
1131       New_Item : Wide_Wide_String)
1132    is
1133       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1134       DL : constant Natural := SR.Last + New_Item'Length;
1135       DR : Shared_Wide_Wide_String_Access;
1136
1137    begin
1138       --  Check bounds
1139
1140       if Before > SR.Last + 1 then
1141          raise Index_Error;
1142       end if;
1143
1144       --  Result is empty string, reuse empty shared string
1145
1146       if DL = 0 then
1147          Reference (Empty_Shared_Wide_Wide_String'Access);
1148          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1149          Unreference (SR);
1150
1151       --  Inserted string is empty, nothing to do
1152
1153       elsif New_Item'Length = 0 then
1154          null;
1155
1156       --  Try to reuse existent shared string first
1157
1158       elsif Can_Be_Reused (SR, DL) then
1159          SR.Data (Before + New_Item'Length .. DL) :=
1160            SR.Data (Before .. SR.Last);
1161          SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1162          SR.Last := DL;
1163
1164       --  Otherwise, allocate new shared string and fill it
1165
1166       else
1167          DR := Allocate (DL + DL / Growth_Factor);
1168          DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
1169          DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
1170          DR.Data (Before + New_Item'Length .. DL) :=
1171            SR.Data (Before .. SR.Last);
1172          DR.Last := DL;
1173          Source.Reference := DR;
1174          Unreference (SR);
1175       end if;
1176    end Insert;
1177
1178    ------------
1179    -- Length --
1180    ------------
1181
1182    function Length (Source : Unbounded_Wide_Wide_String) return Natural is
1183    begin
1184       return Source.Reference.Last;
1185    end Length;
1186
1187    ---------------
1188    -- Overwrite --
1189    ---------------
1190
1191    function Overwrite
1192      (Source   : Unbounded_Wide_Wide_String;
1193       Position : Positive;
1194       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
1195    is
1196       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1197       DL : Natural;
1198       DR : Shared_Wide_Wide_String_Access;
1199
1200    begin
1201       --  Check bounds
1202
1203       if Position > SR.Last + 1 then
1204          raise Index_Error;
1205       end if;
1206
1207       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1208
1209       --  Result is empty string, reuse empty shared string
1210
1211       if DL = 0 then
1212          Reference (Empty_Shared_Wide_Wide_String'Access);
1213          DR := Empty_Shared_Wide_Wide_String'Access;
1214
1215       --  Result is same with source string, reuse source shared string
1216
1217       elsif New_Item'Length = 0 then
1218          Reference (SR);
1219          DR := SR;
1220
1221       --  Otherwise, allocate new shared string and fill it
1222
1223       else
1224          DR := Allocate (DL);
1225          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1226          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1227          DR.Data (Position + New_Item'Length .. DL) :=
1228            SR.Data (Position + New_Item'Length .. SR.Last);
1229          DR.Last := DL;
1230       end if;
1231
1232       return (AF.Controlled with Reference => DR);
1233    end Overwrite;
1234
1235    procedure Overwrite
1236      (Source    : in out Unbounded_Wide_Wide_String;
1237       Position  : Positive;
1238       New_Item  : Wide_Wide_String)
1239    is
1240       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1241       DL : Natural;
1242       DR : Shared_Wide_Wide_String_Access;
1243
1244    begin
1245       --  Bounds check
1246
1247       if Position > SR.Last + 1 then
1248          raise Index_Error;
1249       end if;
1250
1251       DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
1252
1253       --  Result is empty string, reuse empty shared string
1254
1255       if DL = 0 then
1256          Reference (Empty_Shared_Wide_Wide_String'Access);
1257          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1258          Unreference (SR);
1259
1260       --  String unchanged, nothing to do
1261
1262       elsif New_Item'Length = 0 then
1263          null;
1264
1265       --  Try to reuse existent shared string
1266
1267       elsif Can_Be_Reused (SR, DL) then
1268          SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1269          SR.Last := DL;
1270
1271       --  Otherwise allocate new shared string and fill it
1272
1273       else
1274          DR := Allocate (DL);
1275          DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
1276          DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
1277          DR.Data (Position + New_Item'Length .. DL) :=
1278            SR.Data (Position + New_Item'Length .. SR.Last);
1279          DR.Last := DL;
1280          Source.Reference := DR;
1281          Unreference (SR);
1282       end if;
1283    end Overwrite;
1284
1285    ---------------
1286    -- Reference --
1287    ---------------
1288
1289    procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
1290    begin
1291       System.Atomic_Counters.Increment (Item.Counter);
1292    end Reference;
1293
1294    ---------------------
1295    -- Replace_Element --
1296    ---------------------
1297
1298    procedure Replace_Element
1299      (Source : in out Unbounded_Wide_Wide_String;
1300       Index  : Positive;
1301       By     : Wide_Wide_Character)
1302    is
1303       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1304       DR : Shared_Wide_Wide_String_Access;
1305
1306    begin
1307       --  Bounds check
1308
1309       if Index <= SR.Last then
1310
1311          --  Try to reuse existent shared string
1312
1313          if Can_Be_Reused (SR, SR.Last) then
1314             SR.Data (Index) := By;
1315
1316          --  Otherwise allocate new shared string and fill it
1317
1318          else
1319             DR := Allocate (SR.Last);
1320             DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
1321             DR.Data (Index) := By;
1322             DR.Last := SR.Last;
1323             Source.Reference := DR;
1324             Unreference (SR);
1325          end if;
1326
1327       else
1328          raise Index_Error;
1329       end if;
1330    end Replace_Element;
1331
1332    -------------------
1333    -- Replace_Slice --
1334    -------------------
1335
1336    function Replace_Slice
1337      (Source : Unbounded_Wide_Wide_String;
1338       Low    : Positive;
1339       High   : Natural;
1340       By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
1341    is
1342       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1343       DL : Natural;
1344       DR : Shared_Wide_Wide_String_Access;
1345
1346    begin
1347       --  Check bounds
1348
1349       if Low > SR.Last + 1 then
1350          raise Index_Error;
1351       end if;
1352
1353       --  Do replace operation when removed slice is not empty
1354
1355       if High >= Low then
1356          DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1357          --  This is the number of characters remaining in the string after
1358          --  replacing the slice.
1359
1360          --  Result is empty string, reuse empty shared string
1361
1362          if DL = 0 then
1363             Reference (Empty_Shared_Wide_Wide_String'Access);
1364             DR := Empty_Shared_Wide_Wide_String'Access;
1365
1366          --  Otherwise allocate new shared string and fill it
1367
1368          else
1369             DR := Allocate (DL);
1370             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1371             DR.Data (Low .. Low + By'Length - 1) := By;
1372             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1373             DR.Last := DL;
1374          end if;
1375
1376          return (AF.Controlled with Reference => DR);
1377
1378       --  Otherwise just insert string
1379
1380       else
1381          return Insert (Source, Low, By);
1382       end if;
1383    end Replace_Slice;
1384
1385    procedure Replace_Slice
1386      (Source : in out Unbounded_Wide_Wide_String;
1387       Low    : Positive;
1388       High   : Natural;
1389       By     : Wide_Wide_String)
1390    is
1391       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1392       DL : Natural;
1393       DR : Shared_Wide_Wide_String_Access;
1394
1395    begin
1396       --  Bounds check
1397
1398       if Low > SR.Last + 1 then
1399          raise Index_Error;
1400       end if;
1401
1402       --  Do replace operation only when replaced slice is not empty
1403
1404       if High >= Low then
1405          DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
1406          --  This is the number of characters remaining in the string after
1407          --  replacing the slice.
1408
1409          --  Result is empty string, reuse empty shared string
1410
1411          if DL = 0 then
1412             Reference (Empty_Shared_Wide_Wide_String'Access);
1413             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1414             Unreference (SR);
1415
1416          --  Try to reuse existent shared string
1417
1418          elsif Can_Be_Reused (SR, DL) then
1419             SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1420             SR.Data (Low .. Low + By'Length - 1) := By;
1421             SR.Last := DL;
1422
1423          --  Otherwise allocate new shared string and fill it
1424
1425          else
1426             DR := Allocate (DL);
1427             DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
1428             DR.Data (Low .. Low + By'Length - 1) := By;
1429             DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
1430             DR.Last := DL;
1431             Source.Reference := DR;
1432             Unreference (SR);
1433          end if;
1434
1435       --  Otherwise just insert item
1436
1437       else
1438          Insert (Source, Low, By);
1439       end if;
1440    end Replace_Slice;
1441
1442    -------------------------------
1443    -- Set_Unbounded_Wide_Wide_String --
1444    -------------------------------
1445
1446    procedure Set_Unbounded_Wide_Wide_String
1447      (Target : out Unbounded_Wide_Wide_String;
1448       Source : Wide_Wide_String)
1449    is
1450       TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
1451       DR : Shared_Wide_Wide_String_Access;
1452
1453    begin
1454       --  In case of empty string, reuse empty shared string
1455
1456       if Source'Length = 0 then
1457          Reference (Empty_Shared_Wide_Wide_String'Access);
1458          Target.Reference := Empty_Shared_Wide_Wide_String'Access;
1459
1460       else
1461          --  Try to reuse existent shared string
1462
1463          if Can_Be_Reused (TR, Source'Length) then
1464             Reference (TR);
1465             DR := TR;
1466
1467          --  Otherwise allocate new shared string
1468
1469          else
1470             DR := Allocate (Source'Length);
1471             Target.Reference := DR;
1472          end if;
1473
1474          DR.Data (1 .. Source'Length) := Source;
1475          DR.Last := Source'Length;
1476       end if;
1477
1478       Unreference (TR);
1479    end Set_Unbounded_Wide_Wide_String;
1480
1481    -----------
1482    -- Slice --
1483    -----------
1484
1485    function Slice
1486      (Source : Unbounded_Wide_Wide_String;
1487       Low    : Positive;
1488       High   : Natural) return Wide_Wide_String
1489    is
1490       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1491
1492    begin
1493       --  Note: test of High > Length is in accordance with AI95-00128
1494
1495       if Low > SR.Last + 1 or else High > SR.Last then
1496          raise Index_Error;
1497
1498       else
1499          return SR.Data (Low .. High);
1500       end if;
1501    end Slice;
1502
1503    ----------
1504    -- Tail --
1505    ----------
1506
1507    function Tail
1508      (Source : Unbounded_Wide_Wide_String;
1509       Count  : Natural;
1510       Pad    : Wide_Wide_Character := Wide_Wide_Space)
1511       return Unbounded_Wide_Wide_String
1512    is
1513       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1514       DR : Shared_Wide_Wide_String_Access;
1515
1516    begin
1517       --  For empty result reuse empty shared string
1518
1519       if Count = 0 then
1520          Reference (Empty_Shared_Wide_Wide_String'Access);
1521          DR := Empty_Shared_Wide_Wide_String'Access;
1522
1523       --  Result is hole source string, reuse source shared string
1524
1525       elsif Count = SR.Last then
1526          Reference (SR);
1527          DR := SR;
1528
1529       --  Otherwise allocate new shared string and fill it
1530
1531       else
1532          DR := Allocate (Count);
1533
1534          if Count < SR.Last then
1535             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1536
1537          else
1538             for J in 1 .. Count - SR.Last loop
1539                DR.Data (J) := Pad;
1540             end loop;
1541
1542             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1543          end if;
1544
1545          DR.Last := Count;
1546       end if;
1547
1548       return (AF.Controlled with Reference => DR);
1549    end Tail;
1550
1551    procedure Tail
1552      (Source : in out Unbounded_Wide_Wide_String;
1553       Count  : Natural;
1554       Pad    : Wide_Wide_Character := Wide_Wide_Space)
1555    is
1556       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1557       DR : Shared_Wide_Wide_String_Access;
1558
1559       procedure Common
1560         (SR    : Shared_Wide_Wide_String_Access;
1561          DR    : Shared_Wide_Wide_String_Access;
1562          Count : Natural);
1563       --  Common code of tail computation. SR/DR can point to the same object
1564
1565       ------------
1566       -- Common --
1567       ------------
1568
1569       procedure Common
1570         (SR    : Shared_Wide_Wide_String_Access;
1571          DR    : Shared_Wide_Wide_String_Access;
1572          Count : Natural) is
1573       begin
1574          if Count < SR.Last then
1575             DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
1576
1577          else
1578             DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
1579
1580             for J in 1 .. Count - SR.Last loop
1581                DR.Data (J) := Pad;
1582             end loop;
1583          end if;
1584
1585          DR.Last := Count;
1586       end Common;
1587
1588    begin
1589       --  Result is empty string, reuse empty shared string
1590
1591       if Count = 0 then
1592          Reference (Empty_Shared_Wide_Wide_String'Access);
1593          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1594          Unreference (SR);
1595
1596       --  Length of the result is the same with length of the source string,
1597       --  reuse source shared string.
1598
1599       elsif Count = SR.Last then
1600          null;
1601
1602       --  Try to reuse existent shared string
1603
1604       elsif Can_Be_Reused (SR, Count) then
1605          Common (SR, SR, Count);
1606
1607       --  Otherwise allocate new shared string and fill it
1608
1609       else
1610          DR := Allocate (Count);
1611          Common (SR, DR, Count);
1612          Source.Reference := DR;
1613          Unreference (SR);
1614       end if;
1615    end Tail;
1616
1617    -------------------------
1618    -- To_Wide_Wide_String --
1619    -------------------------
1620
1621    function To_Wide_Wide_String
1622      (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is
1623    begin
1624       return Source.Reference.Data (1 .. Source.Reference.Last);
1625    end To_Wide_Wide_String;
1626
1627    -----------------------------------
1628    -- To_Unbounded_Wide_Wide_String --
1629    -----------------------------------
1630
1631    function To_Unbounded_Wide_Wide_String
1632      (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
1633    is
1634       DR : Shared_Wide_Wide_String_Access;
1635
1636    begin
1637       if Source'Length = 0 then
1638          Reference (Empty_Shared_Wide_Wide_String'Access);
1639          DR := Empty_Shared_Wide_Wide_String'Access;
1640
1641       else
1642          DR := Allocate (Source'Length);
1643          DR.Data (1 .. Source'Length) := Source;
1644          DR.Last := Source'Length;
1645       end if;
1646
1647       return (AF.Controlled with Reference => DR);
1648    end To_Unbounded_Wide_Wide_String;
1649
1650    function To_Unbounded_Wide_Wide_String
1651      (Length : Natural) return Unbounded_Wide_Wide_String
1652    is
1653       DR : Shared_Wide_Wide_String_Access;
1654
1655    begin
1656       if Length = 0 then
1657          Reference (Empty_Shared_Wide_Wide_String'Access);
1658          DR := Empty_Shared_Wide_Wide_String'Access;
1659
1660       else
1661          DR := Allocate (Length);
1662          DR.Last := Length;
1663       end if;
1664
1665       return (AF.Controlled with Reference => DR);
1666    end To_Unbounded_Wide_Wide_String;
1667
1668    ---------------
1669    -- Translate --
1670    ---------------
1671
1672    function Translate
1673      (Source  : Unbounded_Wide_Wide_String;
1674       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1675       return Unbounded_Wide_Wide_String
1676    is
1677       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1678       DR : Shared_Wide_Wide_String_Access;
1679
1680    begin
1681       --  Nothing to translate, reuse empty shared string
1682
1683       if SR.Last = 0 then
1684          Reference (Empty_Shared_Wide_Wide_String'Access);
1685          DR := Empty_Shared_Wide_Wide_String'Access;
1686
1687       --  Otherwise, allocate new shared string and fill it
1688
1689       else
1690          DR := Allocate (SR.Last);
1691
1692          for J in 1 .. SR.Last loop
1693             DR.Data (J) := Value (Mapping, SR.Data (J));
1694          end loop;
1695
1696          DR.Last := SR.Last;
1697       end if;
1698
1699       return (AF.Controlled with Reference => DR);
1700    end Translate;
1701
1702    procedure Translate
1703      (Source  : in out Unbounded_Wide_Wide_String;
1704       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
1705    is
1706       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1707       DR : Shared_Wide_Wide_String_Access;
1708
1709    begin
1710       --  Nothing to translate
1711
1712       if SR.Last = 0 then
1713          null;
1714
1715       --  Try to reuse shared string
1716
1717       elsif Can_Be_Reused (SR, SR.Last) then
1718          for J in 1 .. SR.Last loop
1719             SR.Data (J) := Value (Mapping, SR.Data (J));
1720          end loop;
1721
1722       --  Otherwise, allocate new shared string
1723
1724       else
1725          DR := Allocate (SR.Last);
1726
1727          for J in 1 .. SR.Last loop
1728             DR.Data (J) := Value (Mapping, SR.Data (J));
1729          end loop;
1730
1731          DR.Last := SR.Last;
1732          Source.Reference := DR;
1733          Unreference (SR);
1734       end if;
1735    end Translate;
1736
1737    function Translate
1738      (Source  : Unbounded_Wide_Wide_String;
1739       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1740       return Unbounded_Wide_Wide_String
1741    is
1742       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1743       DR : Shared_Wide_Wide_String_Access;
1744
1745    begin
1746       --  Nothing to translate, reuse empty shared string
1747
1748       if SR.Last = 0 then
1749          Reference (Empty_Shared_Wide_Wide_String'Access);
1750          DR := Empty_Shared_Wide_Wide_String'Access;
1751
1752       --  Otherwise, allocate new shared string and fill it
1753
1754       else
1755          DR := Allocate (SR.Last);
1756
1757          for J in 1 .. SR.Last loop
1758             DR.Data (J) := Mapping.all (SR.Data (J));
1759          end loop;
1760
1761          DR.Last := SR.Last;
1762       end if;
1763
1764       return (AF.Controlled with Reference => DR);
1765
1766    exception
1767       when others =>
1768          Unreference (DR);
1769
1770          raise;
1771    end Translate;
1772
1773    procedure Translate
1774      (Source  : in out Unbounded_Wide_Wide_String;
1775       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1776    is
1777       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
1778       DR : Shared_Wide_Wide_String_Access;
1779
1780    begin
1781       --  Nothing to translate
1782
1783       if SR.Last = 0 then
1784          null;
1785
1786       --  Try to reuse shared string
1787
1788       elsif Can_Be_Reused (SR, SR.Last) then
1789          for J in 1 .. SR.Last loop
1790             SR.Data (J) := Mapping.all (SR.Data (J));
1791          end loop;
1792
1793       --  Otherwise allocate new shared string and fill it
1794
1795       else
1796          DR := Allocate (SR.Last);
1797
1798          for J in 1 .. SR.Last loop
1799             DR.Data (J) := Mapping.all (SR.Data (J));
1800          end loop;
1801
1802          DR.Last := SR.Last;
1803          Source.Reference := DR;
1804          Unreference (SR);
1805       end if;
1806
1807    exception
1808       when others =>
1809          if DR /= null then
1810             Unreference (DR);
1811          end if;
1812
1813          raise;
1814    end Translate;
1815
1816    ----------
1817    -- Trim --
1818    ----------
1819
1820    function Trim
1821      (Source : Unbounded_Wide_Wide_String;
1822       Side   : Trim_End) return Unbounded_Wide_Wide_String
1823    is
1824       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1825       DL   : Natural;
1826       DR   : Shared_Wide_Wide_String_Access;
1827       Low  : Natural;
1828       High : Natural;
1829
1830    begin
1831       Low := Index_Non_Blank (Source, Forward);
1832
1833       --  All blanks, reuse empty shared string
1834
1835       if Low = 0 then
1836          Reference (Empty_Shared_Wide_Wide_String'Access);
1837          DR := Empty_Shared_Wide_Wide_String'Access;
1838
1839       else
1840          case Side is
1841             when Left =>
1842                High := SR.Last;
1843                DL   := SR.Last - Low + 1;
1844
1845             when Right =>
1846                Low  := 1;
1847                High := Index_Non_Blank (Source, Backward);
1848                DL   := High;
1849
1850             when Both =>
1851                High := Index_Non_Blank (Source, Backward);
1852                DL   := High - Low + 1;
1853          end case;
1854
1855          --  Length of the result is the same as length of the source string,
1856          --  reuse source shared string.
1857
1858          if DL = SR.Last then
1859             Reference (SR);
1860             DR := SR;
1861
1862          --  Otherwise, allocate new shared string
1863
1864          else
1865             DR := Allocate (DL);
1866             DR.Data (1 .. DL) := SR.Data (Low .. High);
1867             DR.Last := DL;
1868          end if;
1869       end if;
1870
1871       return (AF.Controlled with Reference => DR);
1872    end Trim;
1873
1874    procedure Trim
1875      (Source : in out Unbounded_Wide_Wide_String;
1876       Side   : Trim_End)
1877    is
1878       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1879       DL   : Natural;
1880       DR   : Shared_Wide_Wide_String_Access;
1881       Low  : Natural;
1882       High : Natural;
1883
1884    begin
1885       Low := Index_Non_Blank (Source, Forward);
1886
1887       --  All blanks, reuse empty shared string
1888
1889       if Low = 0 then
1890          Reference (Empty_Shared_Wide_Wide_String'Access);
1891          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1892          Unreference (SR);
1893
1894       else
1895          case Side is
1896             when Left =>
1897                High := SR.Last;
1898                DL   := SR.Last - Low + 1;
1899
1900             when Right =>
1901                Low  := 1;
1902                High := Index_Non_Blank (Source, Backward);
1903                DL   := High;
1904
1905             when Both =>
1906                High := Index_Non_Blank (Source, Backward);
1907                DL   := High - Low + 1;
1908          end case;
1909
1910          --  Length of the result is the same as length of the source string,
1911          --  nothing to do.
1912
1913          if DL = SR.Last then
1914             null;
1915
1916          --  Try to reuse existent shared string
1917
1918          elsif Can_Be_Reused (SR, DL) then
1919             SR.Data (1 .. DL) := SR.Data (Low .. High);
1920             SR.Last := DL;
1921
1922          --  Otherwise, allocate new shared string
1923
1924          else
1925             DR := Allocate (DL);
1926             DR.Data (1 .. DL) := SR.Data (Low .. High);
1927             DR.Last := DL;
1928             Source.Reference := DR;
1929             Unreference (SR);
1930          end if;
1931       end if;
1932    end Trim;
1933
1934    function Trim
1935      (Source : Unbounded_Wide_Wide_String;
1936       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1937       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1938       return Unbounded_Wide_Wide_String
1939    is
1940       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1941       DL   : Natural;
1942       DR   : Shared_Wide_Wide_String_Access;
1943       Low  : Natural;
1944       High : Natural;
1945
1946    begin
1947       Low := Index (Source, Left, Outside, Forward);
1948
1949       --  Source includes only characters from Left set, reuse empty shared
1950       --  string.
1951
1952       if Low = 0 then
1953          Reference (Empty_Shared_Wide_Wide_String'Access);
1954          DR := Empty_Shared_Wide_Wide_String'Access;
1955
1956       else
1957          High := Index (Source, Right, Outside, Backward);
1958          DL   := Integer'Max (0, High - Low + 1);
1959
1960          --  Source includes only characters from Right set or result string
1961          --  is empty, reuse empty shared string.
1962
1963          if High = 0 or else DL = 0 then
1964             Reference (Empty_Shared_Wide_Wide_String'Access);
1965             DR := Empty_Shared_Wide_Wide_String'Access;
1966
1967          --  Otherwise, allocate new shared string and fill it
1968
1969          else
1970             DR := Allocate (DL);
1971             DR.Data (1 .. DL) := SR.Data (Low .. High);
1972             DR.Last := DL;
1973          end if;
1974       end if;
1975
1976       return (AF.Controlled with Reference => DR);
1977    end Trim;
1978
1979    procedure Trim
1980      (Source : in out Unbounded_Wide_Wide_String;
1981       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1982       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1983    is
1984       SR   : constant Shared_Wide_Wide_String_Access := Source.Reference;
1985       DL   : Natural;
1986       DR   : Shared_Wide_Wide_String_Access;
1987       Low  : Natural;
1988       High : Natural;
1989
1990    begin
1991       Low := Index (Source, Left, Outside, Forward);
1992
1993       --  Source includes only characters from Left set, reuse empty shared
1994       --  string.
1995
1996       if Low = 0 then
1997          Reference (Empty_Shared_Wide_Wide_String'Access);
1998          Source.Reference := Empty_Shared_Wide_Wide_String'Access;
1999          Unreference (SR);
2000
2001       else
2002          High := Index (Source, Right, Outside, Backward);
2003          DL   := Integer'Max (0, High - Low + 1);
2004
2005          --  Source includes only characters from Right set or result string
2006          --  is empty, reuse empty shared string.
2007
2008          if High = 0 or else DL = 0 then
2009             Reference (Empty_Shared_Wide_Wide_String'Access);
2010             Source.Reference := Empty_Shared_Wide_Wide_String'Access;
2011             Unreference (SR);
2012
2013          --  Try to reuse existent shared string
2014
2015          elsif Can_Be_Reused (SR, DL) then
2016             SR.Data (1 .. DL) := SR.Data (Low .. High);
2017             SR.Last := DL;
2018
2019          --  Otherwise, allocate new shared string and fill it
2020
2021          else
2022             DR := Allocate (DL);
2023             DR.Data (1 .. DL) := SR.Data (Low .. High);
2024             DR.Last := DL;
2025             Source.Reference := DR;
2026             Unreference (SR);
2027          end if;
2028       end if;
2029    end Trim;
2030
2031    ---------------------
2032    -- Unbounded_Slice --
2033    ---------------------
2034
2035    function Unbounded_Slice
2036      (Source : Unbounded_Wide_Wide_String;
2037       Low    : Positive;
2038       High   : Natural) return Unbounded_Wide_Wide_String
2039    is
2040       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
2041       DL : Natural;
2042       DR : Shared_Wide_Wide_String_Access;
2043
2044    begin
2045       --  Check bounds
2046
2047       if Low > SR.Last + 1 or else High > SR.Last then
2048          raise Index_Error;
2049
2050       --  Result is empty slice, reuse empty shared string
2051
2052       elsif Low > High then
2053          Reference (Empty_Shared_Wide_Wide_String'Access);
2054          DR := Empty_Shared_Wide_Wide_String'Access;
2055
2056       --  Otherwise, allocate new shared string and fill it
2057
2058       else
2059          DL := High - Low + 1;
2060          DR := Allocate (DL);
2061          DR.Data (1 .. DL) := SR.Data (Low .. High);
2062          DR.Last := DL;
2063       end if;
2064
2065       return (AF.Controlled with Reference => DR);
2066    end Unbounded_Slice;
2067
2068    procedure Unbounded_Slice
2069      (Source : Unbounded_Wide_Wide_String;
2070       Target : out Unbounded_Wide_Wide_String;
2071       Low    : Positive;
2072       High   : Natural)
2073    is
2074       SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
2075       TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
2076       DL : Natural;
2077       DR : Shared_Wide_Wide_String_Access;
2078
2079    begin
2080       --  Check bounds
2081
2082       if Low > SR.Last + 1 or else High > SR.Last then
2083          raise Index_Error;
2084
2085       --  Result is empty slice, reuse empty shared string
2086
2087       elsif Low > High then
2088          Reference (Empty_Shared_Wide_Wide_String'Access);
2089          Target.Reference := Empty_Shared_Wide_Wide_String'Access;
2090          Unreference (TR);
2091
2092       else
2093          DL := High - Low + 1;
2094
2095          --  Try to reuse existent shared string
2096
2097          if Can_Be_Reused (TR, DL) then
2098             TR.Data (1 .. DL) := SR.Data (Low .. High);
2099             TR.Last := DL;
2100
2101          --  Otherwise, allocate new shared string and fill it
2102
2103          else
2104             DR := Allocate (DL);
2105             DR.Data (1 .. DL) := SR.Data (Low .. High);
2106             DR.Last := DL;
2107             Target.Reference := DR;
2108             Unreference (TR);
2109          end if;
2110       end if;
2111    end Unbounded_Slice;
2112
2113    -----------------
2114    -- Unreference --
2115    -----------------
2116
2117    procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
2118
2119       procedure Free is
2120         new Ada.Unchecked_Deallocation
2121               (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access);
2122
2123       Aux : Shared_Wide_Wide_String_Access := Item;
2124
2125    begin
2126       if System.Atomic_Counters.Decrement (Aux.Counter) then
2127
2128          --  Reference counter of Empty_Shared_Wide_Wide_String must never
2129          --  reach zero.
2130
2131          pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access);
2132
2133          Free (Aux);
2134       end if;
2135    end Unreference;
2136
2137 end Ada.Strings.Wide_Wide_Unbounded;