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