gcc/ada/a-stzunb.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-2012, 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_Fixed;
  33 with Ada.Strings.Wide_Wide_Search;
  34 with Ada.Unchecked_Deallocation;
  35
  36 package body Ada.Strings.Wide_Wide_Unbounded is
  37
  38    use Ada.Finalization;
  39
  40    ---------
  41    -- "&" --
  42    ---------
  43
  44    function "&"
  45      (Left  : Unbounded_Wide_Wide_String;
  46       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
  47    is
  48       L_Length : constant Natural := Left.Last;
  49       R_Length : constant Natural := Right.Last;
  50       Result   : Unbounded_Wide_Wide_String;
  51
  52    begin
  53       Result.Last := L_Length + R_Length;
  54
  55       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
  56
  57       Result.Reference (1 .. L_Length) :=
  58         Left.Reference (1 .. Left.Last);
  59       Result.Reference (L_Length + 1 .. Result.Last) :=
  60         Right.Reference (1 .. Right.Last);
  61
  62       return Result;
  63    end "&";
  64
  65    function "&"
  66      (Left  : Unbounded_Wide_Wide_String;
  67       Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
  68    is
  69       L_Length : constant Natural := Left.Last;
  70       Result   : Unbounded_Wide_Wide_String;
  71
  72    begin
  73       Result.Last := L_Length + Right'Length;
  74
  75       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
  76
  77       Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
  78       Result.Reference (L_Length + 1 .. Result.Last) := Right;
  79
  80       return Result;
  81    end "&";
  82
  83    function "&"
  84      (Left  : Wide_Wide_String;
  85       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
  86    is
  87       R_Length : constant Natural := Right.Last;
  88       Result   : Unbounded_Wide_Wide_String;
  89
  90    begin
  91       Result.Last := Left'Length + R_Length;
  92
  93       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
  94
  95       Result.Reference (1 .. Left'Length) := Left;
  96       Result.Reference (Left'Length + 1 .. Result.Last) :=
  97         Right.Reference (1 .. Right.Last);
  98
  99       return Result;
 100    end "&";
 101
 102    function "&"
 103      (Left  : Unbounded_Wide_Wide_String;
 104       Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
 105    is
 106       Result : Unbounded_Wide_Wide_String;
 107
 108    begin
 109       Result.Last := Left.Last + 1;
 110
 111       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
 112
 113       Result.Reference (1 .. Result.Last - 1) :=
 114         Left.Reference (1 .. Left.Last);
 115       Result.Reference (Result.Last) := Right;
 116
 117       return Result;
 118    end "&";
 119
 120    function "&"
 121      (Left  : Wide_Wide_Character;
 122       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 123    is
 124       Result : Unbounded_Wide_Wide_String;
 125
 126    begin
 127       Result.Last := Right.Last + 1;
 128
 129       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
 130       Result.Reference (1) := Left;
 131       Result.Reference (2 .. Result.Last) :=
 132         Right.Reference (1 .. Right.Last);
 133       return Result;
 134    end "&";
 135
 136    ---------
 137    -- "*" --
 138    ---------
 139
 140    function "*"
 141      (Left  : Natural;
 142       Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
 143    is
 144       Result : Unbounded_Wide_Wide_String;
 145
 146    begin
 147       Result.Last   := Left;
 148
 149       Result.Reference := new Wide_Wide_String (1 .. Left);
 150       for J in Result.Reference'Range loop
 151          Result.Reference (J) := Right;
 152       end loop;
 153
 154       return Result;
 155    end "*";
 156
 157    function "*"
 158      (Left  : Natural;
 159       Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
 160    is
 161       Len    : constant Natural := Right'Length;
 162       K      : Positive;
 163       Result : Unbounded_Wide_Wide_String;
 164
 165    begin
 166       Result.Last := Left * Len;
 167
 168       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
 169
 170       K := 1;
 171       for J in 1 .. Left loop
 172          Result.Reference (K .. K + Len - 1) := Right;
 173          K := K + Len;
 174       end loop;
 175
 176       return Result;
 177    end "*";
 178
 179    function "*"
 180      (Left  : Natural;
 181       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
 182    is
 183       Len    : constant Natural := Right.Last;
 184       K      : Positive;
 185       Result : Unbounded_Wide_Wide_String;
 186
 187    begin
 188       Result.Last := Left * Len;
 189
 190       Result.Reference := new Wide_Wide_String (1 .. Result.Last);
 191
 192       K := 1;
 193       for J in 1 .. Left loop
 194          Result.Reference (K .. K + Len - 1) :=
 195            Right.Reference (1 .. Right.Last);
 196          K := K + Len;
 197       end loop;
 198
 199       return Result;
 200    end "*";
 201
 202    ---------
 203    -- "<" --
 204    ---------
 205
 206    function "<"
 207      (Left  : Unbounded_Wide_Wide_String;
 208       Right : Unbounded_Wide_Wide_String) return Boolean
 209    is
 210    begin
 211       return
 212         Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
 213    end "<";
 214
 215    function "<"
 216      (Left  : Unbounded_Wide_Wide_String;
 217       Right : Wide_Wide_String) return Boolean
 218    is
 219    begin
 220       return Left.Reference (1 .. Left.Last) < Right;
 221    end "<";
 222
 223    function "<"
 224      (Left  : Wide_Wide_String;
 225       Right : Unbounded_Wide_Wide_String) return Boolean
 226    is
 227    begin
 228       return Left < Right.Reference (1 .. Right.Last);
 229    end "<";
 230
 231    ----------
 232    -- "<=" --
 233    ----------
 234
 235    function "<="
 236      (Left  : Unbounded_Wide_Wide_String;
 237       Right : Unbounded_Wide_Wide_String) return Boolean
 238    is
 239    begin
 240       return
 241         Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
 242    end "<=";
 243
 244    function "<="
 245      (Left  : Unbounded_Wide_Wide_String;
 246       Right : Wide_Wide_String) return Boolean
 247    is
 248    begin
 249       return Left.Reference (1 .. Left.Last) <= Right;
 250    end "<=";
 251
 252    function "<="
 253      (Left  : Wide_Wide_String;
 254       Right : Unbounded_Wide_Wide_String) return Boolean
 255    is
 256    begin
 257       return Left <= Right.Reference (1 .. Right.Last);
 258    end "<=";
 259
 260    ---------
 261    -- "=" --
 262    ---------
 263
 264    function "="
 265      (Left  : Unbounded_Wide_Wide_String;
 266       Right : Unbounded_Wide_Wide_String) return Boolean
 267    is
 268    begin
 269       return
 270         Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
 271    end "=";
 272
 273    function "="
 274      (Left  : Unbounded_Wide_Wide_String;
 275       Right : Wide_Wide_String) return Boolean
 276    is
 277    begin
 278       return Left.Reference (1 .. Left.Last) = Right;
 279    end "=";
 280
 281    function "="
 282      (Left  : Wide_Wide_String;
 283       Right : Unbounded_Wide_Wide_String) return Boolean
 284    is
 285    begin
 286       return Left = Right.Reference (1 .. Right.Last);
 287    end "=";
 288
 289    ---------
 290    -- ">" --
 291    ---------
 292
 293    function ">"
 294      (Left  : Unbounded_Wide_Wide_String;
 295       Right : Unbounded_Wide_Wide_String) return Boolean
 296    is
 297    begin
 298       return
 299         Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
 300    end ">";
 301
 302    function ">"
 303      (Left  : Unbounded_Wide_Wide_String;
 304       Right : Wide_Wide_String) return Boolean
 305    is
 306    begin
 307       return Left.Reference (1 .. Left.Last) > Right;
 308    end ">";
 309
 310    function ">"
 311      (Left  : Wide_Wide_String;
 312       Right : Unbounded_Wide_Wide_String) return Boolean
 313    is
 314    begin
 315       return Left > Right.Reference (1 .. Right.Last);
 316    end ">";
 317
 318    ----------
 319    -- ">=" --
 320    ----------
 321
 322    function ">="
 323      (Left  : Unbounded_Wide_Wide_String;
 324       Right : Unbounded_Wide_Wide_String) return Boolean
 325    is
 326    begin
 327       return
 328         Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
 329    end ">=";
 330
 331    function ">="
 332      (Left  : Unbounded_Wide_Wide_String;
 333       Right : Wide_Wide_String) return Boolean
 334    is
 335    begin
 336       return Left.Reference (1 .. Left.Last) >= Right;
 337    end ">=";
 338
 339    function ">="
 340      (Left  : Wide_Wide_String;
 341       Right : Unbounded_Wide_Wide_String) return Boolean
 342    is
 343    begin
 344       return Left >= Right.Reference (1 .. Right.Last);
 345    end ">=";
 346
 347    ------------
 348    -- Adjust --
 349    ------------
 350
 351    procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
 352    begin
 353       --  Copy string, except we do not copy the statically allocated null
 354       --  string, since it can never be deallocated. Note that we do not copy
 355       --  extra string room here to avoid dragging unused allocated memory.
 356
 357       if Object.Reference /= Null_Wide_Wide_String'Access then
 358          Object.Reference :=
 359            new Wide_Wide_String'(Object.Reference (1 .. Object.Last));
 360       end if;
 361    end Adjust;
 362
 363    ------------
 364    -- Append --
 365    ------------
 366
 367    procedure Append
 368      (Source   : in out Unbounded_Wide_Wide_String;
 369       New_Item : Unbounded_Wide_Wide_String)
 370    is
 371    begin
 372       Realloc_For_Chunk (Source, New_Item.Last);
 373       Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
 374         New_Item.Reference (1 .. New_Item.Last);
 375       Source.Last := Source.Last + New_Item.Last;
 376    end Append;
 377
 378    procedure Append
 379      (Source   : in out Unbounded_Wide_Wide_String;
 380       New_Item : Wide_Wide_String)
 381    is
 382    begin
 383       Realloc_For_Chunk (Source, New_Item'Length);
 384       Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
 385         New_Item;
 386       Source.Last := Source.Last + New_Item'Length;
 387    end Append;
 388
 389    procedure Append
 390      (Source   : in out Unbounded_Wide_Wide_String;
 391       New_Item : Wide_Wide_Character)
 392    is
 393    begin
 394       Realloc_For_Chunk (Source, 1);
 395       Source.Reference (Source.Last + 1) := New_Item;
 396       Source.Last := Source.Last + 1;
 397    end Append;
 398
 399    -----------
 400    -- Count --
 401    -----------
 402
 403    function Count
 404      (Source  : Unbounded_Wide_Wide_String;
 405       Pattern : Wide_Wide_String;
 406       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 407         Wide_Wide_Maps.Identity) return Natural
 408    is
 409    begin
 410       return
 411         Wide_Wide_Search.Count
 412           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 413    end Count;
 414
 415    function Count
 416      (Source  : Unbounded_Wide_Wide_String;
 417       Pattern : Wide_Wide_String;
 418       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 419       return Natural
 420    is
 421    begin
 422       return
 423         Wide_Wide_Search.Count
 424           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 425    end Count;
 426
 427    function Count
 428      (Source : Unbounded_Wide_Wide_String;
 429       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 430    is
 431    begin
 432       return
 433         Wide_Wide_Search.Count
 434         (Source.Reference (1 .. Source.Last), Set);
 435    end Count;
 436
 437    ------------
 438    -- Delete --
 439    ------------
 440
 441    function Delete
 442      (Source  : Unbounded_Wide_Wide_String;
 443       From    : Positive;
 444       Through : Natural) return Unbounded_Wide_Wide_String
 445    is
 446    begin
 447       return
 448         To_Unbounded_Wide_Wide_String
 449           (Wide_Wide_Fixed.Delete
 450              (Source.Reference (1 .. Source.Last), From, Through));
 451    end Delete;
 452
 453    procedure Delete
 454      (Source  : in out Unbounded_Wide_Wide_String;
 455       From    : Positive;
 456       Through : Natural)
 457    is
 458    begin
 459       if From > Through then
 460          null;
 461
 462       elsif From < Source.Reference'First or else Through > Source.Last then
 463          raise Index_Error;
 464
 465       else
 466          declare
 467             Len : constant Natural := Through - From + 1;
 468
 469          begin
 470             Source.Reference (From .. Source.Last - Len) :=
 471               Source.Reference (Through + 1 .. Source.Last);
 472             Source.Last := Source.Last - Len;
 473          end;
 474       end if;
 475    end Delete;
 476
 477    -------------
 478    -- Element --
 479    -------------
 480
 481    function Element
 482      (Source : Unbounded_Wide_Wide_String;
 483       Index  : Positive) return Wide_Wide_Character
 484    is
 485    begin
 486       if Index <= Source.Last then
 487          return Source.Reference (Index);
 488       else
 489          raise Strings.Index_Error;
 490       end if;
 491    end Element;
 492
 493    --------------
 494    -- Finalize --
 495    --------------
 496
 497    procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
 498       procedure Deallocate is
 499         new Ada.Unchecked_Deallocation
 500           (Wide_Wide_String, Wide_Wide_String_Access);
 501
 502    begin
 503       --  Note: Don't try to free statically allocated null string
 504
 505       if Object.Reference /= Null_Wide_Wide_String'Access then
 506          Deallocate (Object.Reference);
 507          Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
 508          Object.Last := 0;
 509       end if;
 510    end Finalize;
 511
 512    ----------------
 513    -- Find_Token --
 514    ----------------
 515
 516    procedure Find_Token
 517      (Source : Unbounded_Wide_Wide_String;
 518       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 519       From   : Positive;
 520       Test   : Strings.Membership;
 521       First  : out Positive;
 522       Last   : out Natural)
 523    is
 524    begin
 525       Wide_Wide_Search.Find_Token
 526         (Source.Reference (From .. Source.Last), Set, Test, First, Last);
 527    end Find_Token;
 528
 529    procedure Find_Token
 530      (Source : Unbounded_Wide_Wide_String;
 531       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 532       Test   : Strings.Membership;
 533       First  : out Positive;
 534       Last   : out Natural)
 535    is
 536    begin
 537       Wide_Wide_Search.Find_Token
 538         (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
 539    end Find_Token;
 540
 541    ----------
 542    -- Free --
 543    ----------
 544
 545    procedure Free (X : in out Wide_Wide_String_Access) is
 546       procedure Deallocate is
 547         new Ada.Unchecked_Deallocation
 548           (Wide_Wide_String, Wide_Wide_String_Access);
 549
 550    begin
 551       --  Note: Do not try to free statically allocated null string
 552
 553       if X /= Null_Unbounded_Wide_Wide_String.Reference then
 554          Deallocate (X);
 555       end if;
 556    end Free;
 557
 558    ----------
 559    -- Head --
 560    ----------
 561
 562    function Head
 563      (Source : Unbounded_Wide_Wide_String;
 564       Count  : Natural;
 565       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 566       return Unbounded_Wide_Wide_String
 567    is
 568    begin
 569       return To_Unbounded_Wide_Wide_String
 570         (Wide_Wide_Fixed.Head
 571            (Source.Reference (1 .. Source.Last), Count, Pad));
 572    end Head;
 573
 574    procedure Head
 575      (Source : in out Unbounded_Wide_Wide_String;
 576       Count  : Natural;
 577       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 578    is
 579       Old : Wide_Wide_String_Access := Source.Reference;
 580    begin
 581       Source.Reference :=
 582         new Wide_Wide_String'
 583           (Wide_Wide_Fixed.Head
 584              (Source.Reference (1 .. Source.Last), Count, Pad));
 585       Source.Last := Source.Reference'Length;
 586       Free (Old);
 587    end Head;
 588
 589    -----------
 590    -- Index --
 591    -----------
 592
 593    function Index
 594      (Source  : Unbounded_Wide_Wide_String;
 595       Pattern : Wide_Wide_String;
 596       Going   : Strings.Direction := Strings.Forward;
 597       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 598         Wide_Wide_Maps.Identity) return Natural
 599    is
 600    begin
 601       return
 602         Wide_Wide_Search.Index
 603           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 604    end Index;
 605
 606    function Index
 607      (Source  : Unbounded_Wide_Wide_String;
 608       Pattern : Wide_Wide_String;
 609       Going   : Direction := Forward;
 610       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 611       return Natural
 612    is
 613    begin
 614       return
 615         Wide_Wide_Search.Index
 616           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 617    end Index;
 618
 619    function Index
 620      (Source : Unbounded_Wide_Wide_String;
 621       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 622       Test   : Strings.Membership := Strings.Inside;
 623       Going  : Strings.Direction  := Strings.Forward) return Natural
 624    is
 625    begin
 626       return Wide_Wide_Search.Index
 627         (Source.Reference (1 .. Source.Last), Set, Test, Going);
 628    end Index;
 629
 630    function Index
 631      (Source  : Unbounded_Wide_Wide_String;
 632       Pattern : Wide_Wide_String;
 633       From    : Positive;
 634       Going   : Direction := Forward;
 635       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 636         Wide_Wide_Maps.Identity) return Natural
 637    is
 638    begin
 639       return
 640         Wide_Wide_Search.Index
 641           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 642    end Index;
 643
 644    function Index
 645      (Source  : Unbounded_Wide_Wide_String;
 646       Pattern : Wide_Wide_String;
 647       From    : Positive;
 648       Going   : Direction := Forward;
 649       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 650       return Natural
 651    is
 652    begin
 653       return
 654         Wide_Wide_Search.Index
 655           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 656    end Index;
 657
 658    function Index
 659      (Source : Unbounded_Wide_Wide_String;
 660       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 661       From   : Positive;
 662       Test   : Membership := Inside;
 663       Going  : Direction := Forward) return Natural
 664    is
 665    begin
 666       return
 667         Wide_Wide_Search.Index
 668           (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
 669    end Index;
 670
 671    function Index_Non_Blank
 672      (Source : Unbounded_Wide_Wide_String;
 673       Going  : Strings.Direction := Strings.Forward) return Natural
 674    is
 675    begin
 676       return
 677         Wide_Wide_Search.Index_Non_Blank
 678           (Source.Reference (1 .. Source.Last), Going);
 679    end Index_Non_Blank;
 680
 681    function Index_Non_Blank
 682      (Source : Unbounded_Wide_Wide_String;
 683       From   : Positive;
 684       Going  : Direction := Forward) return Natural
 685    is
 686    begin
 687       return
 688         Wide_Wide_Search.Index_Non_Blank
 689           (Source.Reference (1 .. Source.Last), From, Going);
 690    end Index_Non_Blank;
 691
 692    ----------------
 693    -- Initialize --
 694    ----------------
 695
 696    procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
 697    begin
 698       Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
 699       Object.Last      := 0;
 700    end Initialize;
 701
 702    ------------
 703    -- Insert --
 704    ------------
 705
 706    function Insert
 707      (Source   : Unbounded_Wide_Wide_String;
 708       Before   : Positive;
 709       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
 710    is
 711    begin
 712       return
 713         To_Unbounded_Wide_Wide_String
 714           (Wide_Wide_Fixed.Insert
 715              (Source.Reference (1 .. Source.Last), Before, New_Item));
 716    end Insert;
 717
 718    procedure Insert
 719      (Source   : in out Unbounded_Wide_Wide_String;
 720       Before   : Positive;
 721       New_Item : Wide_Wide_String)
 722    is
 723    begin
 724       if Before not in Source.Reference'First .. Source.Last + 1 then
 725          raise Index_Error;
 726       end if;
 727
 728       Realloc_For_Chunk (Source, New_Item'Length);
 729
 730       Source.Reference
 731         (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
 732            Source.Reference (Before .. Source.Last);
 733
 734       Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
 735       Source.Last := Source.Last + New_Item'Length;
 736    end Insert;
 737
 738    ------------
 739    -- Length --
 740    ------------
 741
 742    function Length (Source : Unbounded_Wide_Wide_String) return Natural is
 743    begin
 744       return Source.Last;
 745    end Length;
 746
 747    ---------------
 748    -- Overwrite --
 749    ---------------
 750
 751    function Overwrite
 752      (Source   : Unbounded_Wide_Wide_String;
 753       Position : Positive;
 754       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
 755    is
 756    begin
 757       return
 758         To_Unbounded_Wide_Wide_String
 759           (Wide_Wide_Fixed.Overwrite
 760             (Source.Reference (1 .. Source.Last), Position, New_Item));
 761    end Overwrite;
 762
 763    procedure Overwrite
 764      (Source    : in out Unbounded_Wide_Wide_String;
 765       Position  : Positive;
 766       New_Item  : Wide_Wide_String)
 767    is
 768       NL : constant Natural := New_Item'Length;
 769    begin
 770       if Position <= Source.Last - NL + 1 then
 771          Source.Reference (Position .. Position + NL - 1) := New_Item;
 772       else
 773          declare
 774             Old : Wide_Wide_String_Access := Source.Reference;
 775          begin
 776             Source.Reference := new Wide_Wide_String'
 777               (Wide_Wide_Fixed.Overwrite
 778                 (Source.Reference (1 .. Source.Last), Position, New_Item));
 779             Source.Last := Source.Reference'Length;
 780             Free (Old);
 781          end;
 782       end if;
 783    end Overwrite;
 784
 785    -----------------------
 786    -- Realloc_For_Chunk --
 787    -----------------------
 788
 789    procedure Realloc_For_Chunk
 790      (Source     : in out Unbounded_Wide_Wide_String;
 791       Chunk_Size : Natural)
 792    is
 793       Growth_Factor : constant := 32;
 794       --  The growth factor controls how much extra space is allocated when
 795       --  we have to increase the size of an allocated unbounded string. By
 796       --  allocating extra space, we avoid the need to reallocate on every
 797       --  append, particularly important when a string is built up by repeated
 798       --  append operations of small pieces. This is expressed as a factor so
 799       --  32 means add 1/32 of the length of the string as growth space.
 800
 801       Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
 802       --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
 803       --  no memory loss as most (all?) malloc implementations are obliged to
 804       --  align the returned memory on the maximum alignment as malloc does not
 805       --  know the target alignment.
 806
 807       S_Length : constant Natural := Source.Reference'Length;
 808
 809    begin
 810       if Chunk_Size > S_Length - Source.Last then
 811          declare
 812             New_Size : constant Positive :=
 813               S_Length + Chunk_Size + (S_Length / Growth_Factor);
 814
 815             New_Rounded_Up_Size : constant Positive :=
 816               ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
 817
 818             Tmp : constant Wide_Wide_String_Access :=
 819               new Wide_Wide_String (1 .. New_Rounded_Up_Size);
 820
 821          begin
 822             Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
 823             Free (Source.Reference);
 824             Source.Reference := Tmp;
 825          end;
 826       end if;
 827    end Realloc_For_Chunk;
 828
 829    ---------------------
 830    -- Replace_Element --
 831    ---------------------
 832
 833    procedure Replace_Element
 834      (Source : in out Unbounded_Wide_Wide_String;
 835       Index  : Positive;
 836       By     : Wide_Wide_Character)
 837    is
 838    begin
 839       if Index <= Source.Last then
 840          Source.Reference (Index) := By;
 841       else
 842          raise Strings.Index_Error;
 843       end if;
 844    end Replace_Element;
 845
 846    -------------------
 847    -- Replace_Slice --
 848    -------------------
 849
 850    function Replace_Slice
 851      (Source : Unbounded_Wide_Wide_String;
 852       Low    : Positive;
 853       High   : Natural;
 854       By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
 855    is
 856    begin
 857       return To_Unbounded_Wide_Wide_String
 858         (Wide_Wide_Fixed.Replace_Slice
 859            (Source.Reference (1 .. Source.Last), Low, High, By));
 860    end Replace_Slice;
 861
 862    procedure Replace_Slice
 863      (Source : in out Unbounded_Wide_Wide_String;
 864       Low    : Positive;
 865       High   : Natural;
 866       By     : Wide_Wide_String)
 867    is
 868       Old : Wide_Wide_String_Access := Source.Reference;
 869    begin
 870       Source.Reference := new Wide_Wide_String'
 871         (Wide_Wide_Fixed.Replace_Slice
 872            (Source.Reference (1 .. Source.Last), Low, High, By));
 873       Source.Last := Source.Reference'Length;
 874       Free (Old);
 875    end Replace_Slice;
 876
 877    ------------------------------------
 878    -- Set_Unbounded_Wide_Wide_String --
 879    ------------------------------------
 880
 881    procedure Set_Unbounded_Wide_Wide_String
 882      (Target : out Unbounded_Wide_Wide_String;
 883       Source : Wide_Wide_String)
 884    is
 885    begin
 886       Target.Last          := Source'Length;
 887       Target.Reference     := new Wide_Wide_String (1 .. Source'Length);
 888       Target.Reference.all := Source;
 889    end Set_Unbounded_Wide_Wide_String;
 890
 891    -----------
 892    -- Slice --
 893    -----------
 894
 895    function Slice
 896      (Source : Unbounded_Wide_Wide_String;
 897       Low    : Positive;
 898       High   : Natural) return Wide_Wide_String
 899    is
 900    begin
 901       --  Note: test of High > Length is in accordance with AI95-00128
 902
 903       if Low > Source.Last + 1 or else High > Source.Last then
 904          raise Index_Error;
 905       else
 906          return Source.Reference (Low .. High);
 907       end if;
 908    end Slice;
 909
 910    ----------
 911    -- Tail --
 912    ----------
 913
 914    function Tail
 915      (Source : Unbounded_Wide_Wide_String;
 916       Count  : Natural;
 917       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 918       return Unbounded_Wide_Wide_String is
 919    begin
 920       return To_Unbounded_Wide_Wide_String
 921         (Wide_Wide_Fixed.Tail
 922            (Source.Reference (1 .. Source.Last), Count, Pad));
 923    end Tail;
 924
 925    procedure Tail
 926      (Source : in out Unbounded_Wide_Wide_String;
 927       Count  : Natural;
 928       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 929    is
 930       Old : Wide_Wide_String_Access := Source.Reference;
 931    begin
 932       Source.Reference := new Wide_Wide_String'
 933         (Wide_Wide_Fixed.Tail
 934            (Source.Reference (1 .. Source.Last), Count, Pad));
 935       Source.Last := Source.Reference'Length;
 936       Free (Old);
 937    end Tail;
 938
 939    -----------------------------------
 940    -- To_Unbounded_Wide_Wide_String --
 941    -----------------------------------
 942
 943    function To_Unbounded_Wide_Wide_String
 944      (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
 945    is
 946       Result : Unbounded_Wide_Wide_String;
 947    begin
 948       Result.Last          := Source'Length;
 949       Result.Reference     := new Wide_Wide_String (1 .. Source'Length);
 950       Result.Reference.all := Source;
 951       return Result;
 952    end To_Unbounded_Wide_Wide_String;
 953
 954    function To_Unbounded_Wide_Wide_String
 955      (Length : Natural) return Unbounded_Wide_Wide_String
 956    is
 957       Result : Unbounded_Wide_Wide_String;
 958    begin
 959       Result.Last      := Length;
 960       Result.Reference := new Wide_Wide_String (1 .. Length);
 961       return Result;
 962    end To_Unbounded_Wide_Wide_String;
 963
 964    -------------------------
 965    -- To_Wide_Wide_String --
 966    -------------------------
 967
 968    function To_Wide_Wide_String
 969      (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String
 970    is
 971    begin
 972       return Source.Reference (1 .. Source.Last);
 973    end To_Wide_Wide_String;
 974
 975    ---------------
 976    -- Translate --
 977    ---------------
 978
 979    function Translate
 980      (Source  : Unbounded_Wide_Wide_String;
 981       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
 982       return Unbounded_Wide_Wide_String
 983    is
 984    begin
 985       return
 986         To_Unbounded_Wide_Wide_String
 987           (Wide_Wide_Fixed.Translate
 988              (Source.Reference (1 .. Source.Last), Mapping));
 989    end Translate;
 990
 991    procedure Translate
 992      (Source  : in out Unbounded_Wide_Wide_String;
 993       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
 994    is
 995    begin
 996       Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
 997    end Translate;
 998
 999    function Translate
1000      (Source  : Unbounded_Wide_Wide_String;
1001       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1002       return Unbounded_Wide_Wide_String
1003    is
1004    begin
1005       return
1006         To_Unbounded_Wide_Wide_String
1007           (Wide_Wide_Fixed.Translate
1008             (Source.Reference (1 .. Source.Last), Mapping));
1009    end Translate;
1010
1011    procedure Translate
1012      (Source  : in out Unbounded_Wide_Wide_String;
1013       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1014    is
1015    begin
1016       Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1017    end Translate;
1018
1019    ----------
1020    -- Trim --
1021    ----------
1022
1023    function Trim
1024      (Source : Unbounded_Wide_Wide_String;
1025       Side   : Trim_End) return Unbounded_Wide_Wide_String
1026    is
1027    begin
1028       return
1029         To_Unbounded_Wide_Wide_String
1030           (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1031    end Trim;
1032
1033    procedure Trim
1034      (Source : in out Unbounded_Wide_Wide_String;
1035       Side   : Trim_End)
1036    is
1037       Old : Wide_Wide_String_Access := Source.Reference;
1038    begin
1039       Source.Reference :=
1040         new Wide_Wide_String'
1041           (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1042       Source.Last      := Source.Reference'Length;
1043       Free (Old);
1044    end Trim;
1045
1046    function Trim
1047      (Source : Unbounded_Wide_Wide_String;
1048       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1049       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1050       return Unbounded_Wide_Wide_String
1051    is
1052    begin
1053       return
1054         To_Unbounded_Wide_Wide_String
1055           (Wide_Wide_Fixed.Trim
1056              (Source.Reference (1 .. Source.Last), Left, Right));
1057    end Trim;
1058
1059    procedure Trim
1060      (Source : in out Unbounded_Wide_Wide_String;
1061       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1062       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1063    is
1064       Old : Wide_Wide_String_Access := Source.Reference;
1065    begin
1066       Source.Reference :=
1067         new Wide_Wide_String'
1068           (Wide_Wide_Fixed.Trim
1069              (Source.Reference (1 .. Source.Last), Left, Right));
1070       Source.Last      := Source.Reference'Length;
1071       Free (Old);
1072    end Trim;
1073
1074    ---------------------
1075    -- Unbounded_Slice --
1076    ---------------------
1077
1078    function Unbounded_Slice
1079      (Source : Unbounded_Wide_Wide_String;
1080       Low    : Positive;
1081       High   : Natural) return Unbounded_Wide_Wide_String
1082    is
1083    begin
1084       if Low > Source.Last + 1 or else High > Source.Last then
1085          raise Index_Error;
1086       else
1087          return
1088            To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
1089       end if;
1090    end Unbounded_Slice;
1091
1092    procedure Unbounded_Slice
1093      (Source : Unbounded_Wide_Wide_String;
1094       Target : out Unbounded_Wide_Wide_String;
1095       Low    : Positive;
1096       High   : Natural)
1097    is
1098    begin
1099       if Low > Source.Last + 1 or else High > Source.Last then
1100          raise Index_Error;
1101       else
1102          Target :=
1103            To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
1104       end if;
1105    end Unbounded_Slice;
1106
1107 end Ada.Strings.Wide_Wide_Unbounded;