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-2010, 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)
 408       return Natural
 409    is
 410    begin
 411       return
 412         Wide_Wide_Search.Count
 413           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 414    end Count;
 415
 416    function Count
 417      (Source  : Unbounded_Wide_Wide_String;
 418       Pattern : Wide_Wide_String;
 419       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 420       return Natural
 421    is
 422    begin
 423       return
 424         Wide_Wide_Search.Count
 425           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
 426    end Count;
 427
 428    function Count
 429      (Source : Unbounded_Wide_Wide_String;
 430       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
 431    is
 432    begin
 433       return
 434         Wide_Wide_Search.Count
 435         (Source.Reference (1 .. Source.Last), Set);
 436    end Count;
 437
 438    ------------
 439    -- Delete --
 440    ------------
 441
 442    function Delete
 443      (Source  : Unbounded_Wide_Wide_String;
 444       From    : Positive;
 445       Through : Natural) return Unbounded_Wide_Wide_String
 446    is
 447    begin
 448       return
 449         To_Unbounded_Wide_Wide_String
 450           (Wide_Wide_Fixed.Delete
 451              (Source.Reference (1 .. Source.Last), From, Through));
 452    end Delete;
 453
 454    procedure Delete
 455      (Source  : in out Unbounded_Wide_Wide_String;
 456       From    : Positive;
 457       Through : Natural)
 458    is
 459    begin
 460       if From > Through then
 461          null;
 462
 463       elsif From < Source.Reference'First or else Through > Source.Last then
 464          raise Index_Error;
 465
 466       else
 467          declare
 468             Len : constant Natural := Through - From + 1;
 469
 470          begin
 471             Source.Reference (From .. Source.Last - Len) :=
 472               Source.Reference (Through + 1 .. Source.Last);
 473             Source.Last := Source.Last - Len;
 474          end;
 475       end if;
 476    end Delete;
 477
 478    -------------
 479    -- Element --
 480    -------------
 481
 482    function Element
 483      (Source : Unbounded_Wide_Wide_String;
 484       Index  : Positive) return Wide_Wide_Character
 485    is
 486    begin
 487       if Index <= Source.Last then
 488          return Source.Reference (Index);
 489       else
 490          raise Strings.Index_Error;
 491       end if;
 492    end Element;
 493
 494    --------------
 495    -- Finalize --
 496    --------------
 497
 498    procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
 499       procedure Deallocate is
 500         new Ada.Unchecked_Deallocation
 501           (Wide_Wide_String, Wide_Wide_String_Access);
 502
 503    begin
 504       --  Note: Don't try to free statically allocated null string
 505
 506       if Object.Reference /= Null_Wide_Wide_String'Access then
 507          Deallocate (Object.Reference);
 508          Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
 509          Object.Last := 0;
 510       end if;
 511    end Finalize;
 512
 513    ----------------
 514    -- Find_Token --
 515    ----------------
 516
 517    procedure Find_Token
 518      (Source : Unbounded_Wide_Wide_String;
 519       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 520       From   : Positive;
 521       Test   : Strings.Membership;
 522       First  : out Positive;
 523       Last   : out Natural)
 524    is
 525    begin
 526       Wide_Wide_Search.Find_Token
 527         (Source.Reference (From .. Source.Last), Set, Test, First, Last);
 528    end Find_Token;
 529
 530    procedure Find_Token
 531      (Source : Unbounded_Wide_Wide_String;
 532       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 533       Test   : Strings.Membership;
 534       First  : out Positive;
 535       Last   : out Natural)
 536    is
 537    begin
 538       Wide_Wide_Search.Find_Token
 539         (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
 540    end Find_Token;
 541
 542    ----------
 543    -- Free --
 544    ----------
 545
 546    procedure Free (X : in out Wide_Wide_String_Access) is
 547       procedure Deallocate is
 548         new Ada.Unchecked_Deallocation
 549           (Wide_Wide_String, Wide_Wide_String_Access);
 550
 551    begin
 552       --  Note: Do not try to free statically allocated null string
 553
 554       if X /= Null_Unbounded_Wide_Wide_String.Reference then
 555          Deallocate (X);
 556       end if;
 557    end Free;
 558
 559    ----------
 560    -- Head --
 561    ----------
 562
 563    function Head
 564      (Source : Unbounded_Wide_Wide_String;
 565       Count  : Natural;
 566       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 567       return Unbounded_Wide_Wide_String
 568    is
 569    begin
 570       return To_Unbounded_Wide_Wide_String
 571         (Wide_Wide_Fixed.Head
 572            (Source.Reference (1 .. Source.Last), Count, Pad));
 573    end Head;
 574
 575    procedure Head
 576      (Source : in out Unbounded_Wide_Wide_String;
 577       Count  : Natural;
 578       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 579    is
 580       Old : Wide_Wide_String_Access := Source.Reference;
 581    begin
 582       Source.Reference :=
 583         new Wide_Wide_String'
 584           (Wide_Wide_Fixed.Head
 585              (Source.Reference (1 .. Source.Last), Count, Pad));
 586       Source.Last := Source.Reference'Length;
 587       Free (Old);
 588    end Head;
 589
 590    -----------
 591    -- Index --
 592    -----------
 593
 594    function Index
 595      (Source  : Unbounded_Wide_Wide_String;
 596       Pattern : Wide_Wide_String;
 597       Going   : Strings.Direction := Strings.Forward;
 598       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 599                   Wide_Wide_Maps.Identity)
 600       return Natural
 601    is
 602    begin
 603       return
 604         Wide_Wide_Search.Index
 605           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 606    end Index;
 607
 608    function Index
 609      (Source  : Unbounded_Wide_Wide_String;
 610       Pattern : Wide_Wide_String;
 611       Going   : Direction := Forward;
 612       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 613       return Natural
 614    is
 615    begin
 616       return
 617         Wide_Wide_Search.Index
 618           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
 619    end Index;
 620
 621    function Index
 622      (Source : Unbounded_Wide_Wide_String;
 623       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 624       Test   : Strings.Membership := Strings.Inside;
 625       Going  : Strings.Direction  := Strings.Forward) return Natural
 626    is
 627    begin
 628       return Wide_Wide_Search.Index
 629         (Source.Reference (1 .. Source.Last), Set, Test, Going);
 630    end Index;
 631
 632    function Index
 633      (Source  : Unbounded_Wide_Wide_String;
 634       Pattern : Wide_Wide_String;
 635       From    : Positive;
 636       Going   : Direction := Forward;
 637       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 638                   Wide_Wide_Maps.Identity)
 639       return Natural
 640    is
 641    begin
 642       return
 643         Wide_Wide_Search.Index
 644           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 645    end Index;
 646
 647    function Index
 648      (Source  : Unbounded_Wide_Wide_String;
 649       Pattern : Wide_Wide_String;
 650       From    : Positive;
 651       Going   : Direction := Forward;
 652       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 653       return Natural
 654    is
 655    begin
 656       return
 657         Wide_Wide_Search.Index
 658           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
 659    end Index;
 660
 661    function Index
 662      (Source : Unbounded_Wide_Wide_String;
 663       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 664       From   : Positive;
 665       Test   : Membership := Inside;
 666       Going  : Direction := Forward) return Natural
 667    is
 668    begin
 669       return
 670         Wide_Wide_Search.Index
 671           (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
 672    end Index;
 673
 674    function Index_Non_Blank
 675      (Source : Unbounded_Wide_Wide_String;
 676       Going  : Strings.Direction := Strings.Forward) return Natural
 677    is
 678    begin
 679       return
 680         Wide_Wide_Search.Index_Non_Blank
 681           (Source.Reference (1 .. Source.Last), Going);
 682    end Index_Non_Blank;
 683
 684    function Index_Non_Blank
 685      (Source : Unbounded_Wide_Wide_String;
 686       From   : Positive;
 687       Going  : Direction := Forward) return Natural
 688    is
 689    begin
 690       return
 691         Wide_Wide_Search.Index_Non_Blank
 692           (Source.Reference (1 .. Source.Last), From, Going);
 693    end Index_Non_Blank;
 694
 695    ----------------
 696    -- Initialize --
 697    ----------------
 698
 699    procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
 700    begin
 701       Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
 702       Object.Last      := 0;
 703    end Initialize;
 704
 705    ------------
 706    -- Insert --
 707    ------------
 708
 709    function Insert
 710      (Source   : Unbounded_Wide_Wide_String;
 711       Before   : Positive;
 712       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
 713    is
 714    begin
 715       return
 716         To_Unbounded_Wide_Wide_String
 717           (Wide_Wide_Fixed.Insert
 718              (Source.Reference (1 .. Source.Last), Before, New_Item));
 719    end Insert;
 720
 721    procedure Insert
 722      (Source   : in out Unbounded_Wide_Wide_String;
 723       Before   : Positive;
 724       New_Item : Wide_Wide_String)
 725    is
 726    begin
 727       if Before not in Source.Reference'First .. Source.Last + 1 then
 728          raise Index_Error;
 729       end if;
 730
 731       Realloc_For_Chunk (Source, New_Item'Length);
 732
 733       Source.Reference
 734         (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
 735            Source.Reference (Before .. Source.Last);
 736
 737       Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
 738       Source.Last := Source.Last + New_Item'Length;
 739    end Insert;
 740
 741    ------------
 742    -- Length --
 743    ------------
 744
 745    function Length (Source : Unbounded_Wide_Wide_String) return Natural is
 746    begin
 747       return Source.Last;
 748    end Length;
 749
 750    ---------------
 751    -- Overwrite --
 752    ---------------
 753
 754    function Overwrite
 755      (Source   : Unbounded_Wide_Wide_String;
 756       Position : Positive;
 757       New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
 758    is
 759    begin
 760       return
 761         To_Unbounded_Wide_Wide_String
 762           (Wide_Wide_Fixed.Overwrite
 763             (Source.Reference (1 .. Source.Last), Position, New_Item));
 764    end Overwrite;
 765
 766    procedure Overwrite
 767      (Source    : in out Unbounded_Wide_Wide_String;
 768       Position  : Positive;
 769       New_Item  : Wide_Wide_String)
 770    is
 771       NL : constant Natural := New_Item'Length;
 772    begin
 773       if Position <= Source.Last - NL + 1 then
 774          Source.Reference (Position .. Position + NL - 1) := New_Item;
 775       else
 776          declare
 777             Old : Wide_Wide_String_Access := Source.Reference;
 778          begin
 779             Source.Reference := new Wide_Wide_String'
 780               (Wide_Wide_Fixed.Overwrite
 781                 (Source.Reference (1 .. Source.Last), Position, New_Item));
 782             Source.Last := Source.Reference'Length;
 783             Free (Old);
 784          end;
 785       end if;
 786    end Overwrite;
 787
 788    -----------------------
 789    -- Realloc_For_Chunk --
 790    -----------------------
 791
 792    procedure Realloc_For_Chunk
 793      (Source     : in out Unbounded_Wide_Wide_String;
 794       Chunk_Size : Natural)
 795    is
 796       Growth_Factor : constant := 32;
 797       --  The growth factor controls how much extra space is allocated when
 798       --  we have to increase the size of an allocated unbounded string. By
 799       --  allocating extra space, we avoid the need to reallocate on every
 800       --  append, particularly important when a string is built up by repeated
 801       --  append operations of small pieces. This is expressed as a factor so
 802       --  32 means add 1/32 of the length of the string as growth space.
 803
 804       Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
 805       --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
 806       --  no memory loss as most (all?) malloc implementations are obliged to
 807       --  align the returned memory on the maximum alignment as malloc does not
 808       --  know the target alignment.
 809
 810       S_Length : constant Natural := Source.Reference'Length;
 811
 812    begin
 813       if Chunk_Size > S_Length - Source.Last then
 814          declare
 815             New_Size : constant Positive :=
 816                          S_Length + Chunk_Size + (S_Length / Growth_Factor);
 817
 818             New_Rounded_Up_Size : constant Positive :=
 819                                     ((New_Size - 1) / Min_Mul_Alloc + 1) *
 820                                        Min_Mul_Alloc;
 821
 822             Tmp : constant Wide_Wide_String_Access :=
 823                     new Wide_Wide_String (1 .. New_Rounded_Up_Size);
 824
 825          begin
 826             Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
 827             Free (Source.Reference);
 828             Source.Reference := Tmp;
 829          end;
 830       end if;
 831    end Realloc_For_Chunk;
 832
 833    ---------------------
 834    -- Replace_Element --
 835    ---------------------
 836
 837    procedure Replace_Element
 838      (Source : in out Unbounded_Wide_Wide_String;
 839       Index  : Positive;
 840       By     : Wide_Wide_Character)
 841    is
 842    begin
 843       if Index <= Source.Last then
 844          Source.Reference (Index) := By;
 845       else
 846          raise Strings.Index_Error;
 847       end if;
 848    end Replace_Element;
 849
 850    -------------------
 851    -- Replace_Slice --
 852    -------------------
 853
 854    function Replace_Slice
 855      (Source : Unbounded_Wide_Wide_String;
 856       Low    : Positive;
 857       High   : Natural;
 858       By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
 859    is
 860    begin
 861       return To_Unbounded_Wide_Wide_String
 862         (Wide_Wide_Fixed.Replace_Slice
 863            (Source.Reference (1 .. Source.Last), Low, High, By));
 864    end Replace_Slice;
 865
 866    procedure Replace_Slice
 867      (Source : in out Unbounded_Wide_Wide_String;
 868       Low    : Positive;
 869       High   : Natural;
 870       By     : Wide_Wide_String)
 871    is
 872       Old : Wide_Wide_String_Access := Source.Reference;
 873    begin
 874       Source.Reference := new Wide_Wide_String'
 875         (Wide_Wide_Fixed.Replace_Slice
 876            (Source.Reference (1 .. Source.Last), Low, High, By));
 877       Source.Last := Source.Reference'Length;
 878       Free (Old);
 879    end Replace_Slice;
 880
 881    ------------------------------------
 882    -- Set_Unbounded_Wide_Wide_String --
 883    ------------------------------------
 884
 885    procedure Set_Unbounded_Wide_Wide_String
 886      (Target : out Unbounded_Wide_Wide_String;
 887       Source : Wide_Wide_String)
 888    is
 889    begin
 890       Target.Last          := Source'Length;
 891       Target.Reference     := new Wide_Wide_String (1 .. Source'Length);
 892       Target.Reference.all := Source;
 893    end Set_Unbounded_Wide_Wide_String;
 894
 895    -----------
 896    -- Slice --
 897    -----------
 898
 899    function Slice
 900      (Source : Unbounded_Wide_Wide_String;
 901       Low    : Positive;
 902       High   : Natural) return Wide_Wide_String
 903    is
 904    begin
 905       --  Note: test of High > Length is in accordance with AI95-00128
 906
 907       if Low > Source.Last + 1 or else High > Source.Last then
 908          raise Index_Error;
 909       else
 910          return Source.Reference (Low .. High);
 911       end if;
 912    end Slice;
 913
 914    ----------
 915    -- Tail --
 916    ----------
 917
 918    function Tail
 919      (Source : Unbounded_Wide_Wide_String;
 920       Count  : Natural;
 921       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 922       return Unbounded_Wide_Wide_String is
 923    begin
 924       return To_Unbounded_Wide_Wide_String
 925         (Wide_Wide_Fixed.Tail
 926            (Source.Reference (1 .. Source.Last), Count, Pad));
 927    end Tail;
 928
 929    procedure Tail
 930      (Source : in out Unbounded_Wide_Wide_String;
 931       Count  : Natural;
 932       Pad    : Wide_Wide_Character := Wide_Wide_Space)
 933    is
 934       Old : Wide_Wide_String_Access := Source.Reference;
 935    begin
 936       Source.Reference := new Wide_Wide_String'
 937         (Wide_Wide_Fixed.Tail
 938            (Source.Reference (1 .. Source.Last), Count, Pad));
 939       Source.Last := Source.Reference'Length;
 940       Free (Old);
 941    end Tail;
 942
 943    -----------------------------------
 944    -- To_Unbounded_Wide_Wide_String --
 945    -----------------------------------
 946
 947    function To_Unbounded_Wide_Wide_String
 948      (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
 949    is
 950       Result : Unbounded_Wide_Wide_String;
 951    begin
 952       Result.Last          := Source'Length;
 953       Result.Reference     := new Wide_Wide_String (1 .. Source'Length);
 954       Result.Reference.all := Source;
 955       return Result;
 956    end To_Unbounded_Wide_Wide_String;
 957
 958    function To_Unbounded_Wide_Wide_String
 959      (Length : Natural) return Unbounded_Wide_Wide_String
 960    is
 961       Result : Unbounded_Wide_Wide_String;
 962    begin
 963       Result.Last      := Length;
 964       Result.Reference := new Wide_Wide_String (1 .. Length);
 965       return Result;
 966    end To_Unbounded_Wide_Wide_String;
 967
 968    -------------------------
 969    -- To_Wide_Wide_String --
 970    -------------------------
 971
 972    function To_Wide_Wide_String
 973      (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String
 974    is
 975    begin
 976       return Source.Reference (1 .. Source.Last);
 977    end To_Wide_Wide_String;
 978
 979    ---------------
 980    -- Translate --
 981    ---------------
 982
 983    function Translate
 984      (Source  : Unbounded_Wide_Wide_String;
 985       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
 986       return Unbounded_Wide_Wide_String
 987    is
 988    begin
 989       return
 990         To_Unbounded_Wide_Wide_String
 991           (Wide_Wide_Fixed.Translate
 992              (Source.Reference (1 .. Source.Last), Mapping));
 993    end Translate;
 994
 995    procedure Translate
 996      (Source  : in out Unbounded_Wide_Wide_String;
 997       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
 998    is
 999    begin
1000       Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1001    end Translate;
1002
1003    function Translate
1004      (Source  : Unbounded_Wide_Wide_String;
1005       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1006       return Unbounded_Wide_Wide_String
1007    is
1008    begin
1009       return
1010         To_Unbounded_Wide_Wide_String
1011           (Wide_Wide_Fixed.Translate
1012             (Source.Reference (1 .. Source.Last), Mapping));
1013    end Translate;
1014
1015    procedure Translate
1016      (Source  : in out Unbounded_Wide_Wide_String;
1017       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1018    is
1019    begin
1020       Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1021    end Translate;
1022
1023    ----------
1024    -- Trim --
1025    ----------
1026
1027    function Trim
1028      (Source : Unbounded_Wide_Wide_String;
1029       Side   : Trim_End) return Unbounded_Wide_Wide_String
1030    is
1031    begin
1032       return
1033         To_Unbounded_Wide_Wide_String
1034           (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1035    end Trim;
1036
1037    procedure Trim
1038      (Source : in out Unbounded_Wide_Wide_String;
1039       Side   : Trim_End)
1040    is
1041       Old : Wide_Wide_String_Access := Source.Reference;
1042    begin
1043       Source.Reference :=
1044         new Wide_Wide_String'
1045           (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1046       Source.Last      := Source.Reference'Length;
1047       Free (Old);
1048    end Trim;
1049
1050    function Trim
1051      (Source : Unbounded_Wide_Wide_String;
1052       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1053       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1054       return Unbounded_Wide_Wide_String
1055    is
1056    begin
1057       return
1058         To_Unbounded_Wide_Wide_String
1059           (Wide_Wide_Fixed.Trim
1060              (Source.Reference (1 .. Source.Last), Left, Right));
1061    end Trim;
1062
1063    procedure Trim
1064      (Source : in out Unbounded_Wide_Wide_String;
1065       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
1066       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set)
1067    is
1068       Old : Wide_Wide_String_Access := Source.Reference;
1069    begin
1070       Source.Reference :=
1071         new Wide_Wide_String'
1072           (Wide_Wide_Fixed.Trim
1073              (Source.Reference (1 .. Source.Last), Left, Right));
1074       Source.Last      := Source.Reference'Length;
1075       Free (Old);
1076    end Trim;
1077
1078    ---------------------
1079    -- Unbounded_Slice --
1080    ---------------------
1081
1082    function Unbounded_Slice
1083      (Source : Unbounded_Wide_Wide_String;
1084       Low    : Positive;
1085       High   : Natural) return Unbounded_Wide_Wide_String
1086    is
1087    begin
1088       if Low > Source.Last + 1 or else High > Source.Last then
1089          raise Index_Error;
1090       else
1091          return
1092            To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
1093       end if;
1094    end Unbounded_Slice;
1095
1096    procedure Unbounded_Slice
1097      (Source : Unbounded_Wide_Wide_String;
1098       Target : out Unbounded_Wide_Wide_String;
1099       Low    : Positive;
1100       High   : Natural)
1101    is
1102    begin
1103       if Low > Source.Last + 1 or else High > Source.Last then
1104          raise Index_Error;
1105       else
1106          Target :=
1107            To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
1108       end if;
1109    end Unbounded_Slice;
1110
1111 end Ada.Strings.Wide_Wide_Unbounded;