gcc/ada/libgnat/a-strunb.adb

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