gcc/ada/a-stwiun.adb

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