gcc/ada/a-stzunb.adb

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