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