gcc/ada/a-strbou.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUNTIME COMPONENTS                          --
   4 --                                                                          --
   5 --                  A D A . S T R I N G S . B O U N D E D                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- As a special exception,  if other files  instantiate  generics from this --
  24 -- unit, or you link  this unit with other files  to produce an executable, --
  25 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  26 -- covered  by the  GNU  General  Public  License.  This exception does not --
  27 -- however invalidate  any other reasons why  the executable file  might be --
  28 -- covered by the  GNU Public License.                                      --
  29 --                                                                          --
  30 -- GNAT was originally developed  by the GNAT team at  New York University. --
  31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  32 --                                                                          --
  33 ------------------------------------------------------------------------------
  34
  35 with Ada.Strings.Maps;   use Ada.Strings.Maps;
  36 with Ada.Strings.Search;
  37
  38 package body Ada.Strings.Bounded is
  39
  40    package body Generic_Bounded_Length is
  41
  42       ---------
  43       -- "&" --
  44       ---------
  45
  46       function "&"
  47         (Left  : in Bounded_String;
  48          Right : in Bounded_String)
  49          return  Bounded_String
  50       is
  51          Result : Bounded_String;
  52          Llen   : constant Length_Range := Left.Length;
  53          Rlen   : constant Length_Range := Right.Length;
  54          Nlen   : constant Natural      := Llen + Rlen;
  55
  56       begin
  57          if Nlen > Max_Length then
  58             raise Ada.Strings.Length_Error;
  59          else
  60             Result.Length := Nlen;
  61             Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
  62             Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
  63          end if;
  64
  65          return Result;
  66       end "&";
  67
  68       function "&"
  69         (Left  : in Bounded_String;
  70          Right : in String)
  71          return  Bounded_String
  72       is
  73          Result : Bounded_String;
  74          Llen   : constant Length_Range := Left.Length;
  75
  76          Nlen   : constant Natural      := Llen + Right'Length;
  77
  78       begin
  79          if Nlen > Max_Length then
  80             raise Ada.Strings.Length_Error;
  81          else
  82             Result.Length := Nlen;
  83             Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
  84             Result.Data (Llen + 1 .. Nlen) := Right;
  85          end if;
  86          return Result;
  87       end "&";
  88
  89       function "&"
  90         (Left  : in String;
  91          Right : in Bounded_String)
  92          return  Bounded_String
  93       is
  94          Result : Bounded_String;
  95          Llen   : constant Length_Range := Left'Length;
  96          Rlen   : constant Length_Range := Right.Length;
  97          Nlen   : constant Natural      := Llen + Rlen;
  98
  99       begin
 100          if Nlen > Max_Length then
 101             raise Ada.Strings.Length_Error;
 102          else
 103             Result.Length := Nlen;
 104             Result.Data (1 .. Llen) := Left;
 105             Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
 106          end if;
 107
 108          return Result;
 109       end "&";
 110
 111       function "&"
 112         (Left  : in Bounded_String;
 113          Right : in Character)
 114          return  Bounded_String
 115       is
 116          Result : Bounded_String;
 117          Llen   : constant Length_Range := Left.Length;
 118
 119       begin
 120          if Llen = Max_Length then
 121             raise Ada.Strings.Length_Error;
 122          else
 123             Result.Length := Llen + 1;
 124             Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
 125             Result.Data (Result.Length) := Right;
 126          end if;
 127
 128          return Result;
 129       end "&";
 130
 131       function "&"
 132         (Left  : in Character;
 133          Right : in Bounded_String)
 134          return  Bounded_String
 135       is
 136          Result : Bounded_String;
 137          Rlen   : Length_Range := Right.Length;
 138
 139       begin
 140          if Rlen = Max_Length then
 141             raise Ada.Strings.Length_Error;
 142          else
 143             Result.Length := Rlen + 1;
 144             Result.Data (1) := Left;
 145             Result.Data (2 .. Result.Length) := Right.Data (1 .. Rlen);
 146          end if;
 147
 148          return Result;
 149       end "&";
 150
 151       ---------
 152       -- "*" --
 153       ---------
 154
 155       function "*"
 156         (Left  : in Natural;
 157          Right : in Character)
 158          return  Bounded_String
 159       is
 160          Result : Bounded_String;
 161
 162       begin
 163          if Left > Max_Length then
 164             raise Ada.Strings.Length_Error;
 165          else
 166             Result.Length := Left;
 167
 168             for J in 1 .. Left loop
 169                Result.Data (J) := Right;
 170             end loop;
 171          end if;
 172
 173          return Result;
 174       end "*";
 175
 176       function "*"
 177         (Left  : in Natural;
 178          Right : in String)
 179          return  Bounded_String
 180       is
 181          Result : Bounded_String;
 182          Pos    : Positive         := 1;
 183          Rlen   : constant Natural := Right'Length;
 184          Nlen   : constant Natural := Left * Rlen;
 185
 186       begin
 187          if Nlen > Max_Length then
 188             raise Ada.Strings.Index_Error;
 189          else
 190             Result.Length := Nlen;
 191
 192             if Nlen > 0 then
 193                for J in 1 .. Left loop
 194                   Result.Data (Pos .. Pos + Rlen - 1) := Right;
 195                   Pos := Pos + Rlen;
 196                end loop;
 197             end if;
 198          end if;
 199
 200          return Result;
 201       end "*";
 202
 203       function "*"
 204         (Left  : in Natural;
 205          Right : in Bounded_String)
 206          return  Bounded_String
 207       is
 208          Result : Bounded_String;
 209          Pos    : Positive := 1;
 210          Rlen   : constant Length_Range := Right.Length;
 211          Nlen   : constant Natural      := Left * Rlen;
 212
 213       begin
 214          if Nlen > Max_Length then
 215             raise Ada.Strings.Length_Error;
 216
 217          else
 218             Result.Length := Nlen;
 219
 220             if Nlen > 0 then
 221                for J in 1 .. Left loop
 222                   Result.Data (Pos .. Pos + Rlen - 1) :=
 223                     Right.Data (1 .. Rlen);
 224                   Pos := Pos + Rlen;
 225                end loop;
 226             end if;
 227          end if;
 228
 229          return Result;
 230       end "*";
 231
 232       ---------
 233       -- "<" --
 234       ---------
 235
 236       function "<" (Left, Right : in Bounded_String) return Boolean is
 237       begin
 238          return Left.Data (1 .. Left.Length) < Right.Data (1 .. Right.Length);
 239       end "<";
 240
 241       function "<"
 242         (Left  : in Bounded_String;
 243          Right : in String)
 244          return  Boolean
 245       is
 246       begin
 247          return Left.Data (1 .. Left.Length) < Right;
 248       end "<";
 249
 250       function "<"
 251         (Left  : in String;
 252          Right : in Bounded_String)
 253          return  Boolean
 254       is
 255       begin
 256          return Left < Right.Data (1 .. Right.Length);
 257       end "<";
 258
 259       ----------
 260       -- "<=" --
 261       ----------
 262
 263       function "<=" (Left, Right : in Bounded_String) return Boolean is
 264       begin
 265          return Left.Data (1 .. Left.Length) <= Right.Data (1 .. Right.Length);
 266       end "<=";
 267
 268       function "<="
 269         (Left  : in Bounded_String;
 270          Right : in String)
 271          return  Boolean
 272       is
 273       begin
 274          return Left.Data (1 .. Left.Length) <= Right;
 275       end "<=";
 276
 277       function "<="
 278         (Left  : in String;
 279          Right : in Bounded_String)
 280          return  Boolean
 281       is
 282       begin
 283          return Left <= Right.Data (1 .. Right.Length);
 284       end "<=";
 285
 286       ---------
 287       -- "=" --
 288       ---------
 289
 290       function "=" (Left, Right : in Bounded_String) return Boolean is
 291       begin
 292          return Left.Length = Right.Length
 293            and then Left.Data (1 .. Left.Length) =
 294                     Right.Data (1 .. Right.Length);
 295       end "=";
 296
 297       function "="  (Left : in Bounded_String; Right : in String)
 298          return Boolean is
 299       begin
 300          return Left.Length = Right'Length
 301            and then Left.Data (1 .. Left.Length) = Right;
 302       end "=";
 303
 304       function "="  (Left : in String; Right : in Bounded_String)
 305          return Boolean is
 306       begin
 307          return Left'Length = Right.Length
 308            and then Left = Right.Data (1 .. Right.Length);
 309       end "=";
 310
 311       ---------
 312       -- ">" --
 313       ---------
 314
 315       function ">" (Left, Right : in Bounded_String) return Boolean is
 316       begin
 317          return Left.Data (1 .. Left.Length) > Right.Data (1 .. Right.Length);
 318       end ">";
 319
 320       function ">"
 321         (Left  : in Bounded_String;
 322          Right : in String)
 323          return  Boolean
 324       is
 325       begin
 326          return Left.Data (1 .. Left.Length) > Right;
 327       end ">";
 328
 329       function ">"
 330         (Left  : in String;
 331          Right : in Bounded_String)
 332          return  Boolean
 333       is
 334       begin
 335          return Left > Right.Data (1 .. Right.Length);
 336       end ">";
 337
 338       ----------
 339       -- ">=" --
 340       ----------
 341
 342       function ">=" (Left, Right : in Bounded_String) return Boolean is
 343       begin
 344          return Left.Data (1 .. Left.Length) >= Right.Data (1 .. Right.Length);
 345       end ">=";
 346
 347       function ">="
 348         (Left  : in Bounded_String;
 349          Right : in String)
 350          return  Boolean
 351       is
 352       begin
 353          return Left.Data (1 .. Left.Length) >= Right;
 354       end ">=";
 355
 356       function ">="
 357         (Left  : in String;
 358          Right : in Bounded_String)
 359          return  Boolean
 360       is
 361       begin
 362          return Left >= Right.Data (1 .. Right.Length);
 363       end ">=";
 364
 365       ------------
 366       -- Append --
 367       ------------
 368
 369       --  Case of Bounded_String and Bounded_String
 370
 371       function Append
 372         (Left, Right : in Bounded_String;
 373          Drop        : in Strings.Truncation  := Strings.Error)
 374          return        Bounded_String
 375       is
 376          Result : Bounded_String;
 377          Llen   : constant Length_Range := Left.Length;
 378          Rlen   : constant Length_Range := Right.Length;
 379          Nlen   : constant Natural      := Llen + Rlen;
 380
 381       begin
 382          if Nlen <= Max_Length then
 383             Result.Length := Nlen;
 384             Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
 385             Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
 386
 387          else
 388             Result.Length := Max_Length;
 389
 390             case Drop is
 391                when Strings.Right =>
 392                   if Llen >= Max_Length then -- only case is Llen = Max_Length
 393                      Result.Data := Left.Data;
 394
 395                   else
 396                      Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
 397                      Result.Data (Llen + 1 .. Max_Length) :=
 398                        Right.Data (1 .. Max_Length - Llen);
 399                   end if;
 400
 401                when Strings.Left =>
 402                   if Rlen >= Max_Length then -- only case is Rlen = Max_Length
 403                      Result.Data := Right.Data;
 404
 405                   else
 406                      Result.Data (1 .. Max_Length - Rlen) :=
 407                        Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
 408                      Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
 409                        Right.Data (1 .. Rlen);
 410                   end if;
 411
 412                when Strings.Error =>
 413                   raise Ada.Strings.Length_Error;
 414             end case;
 415          end if;
 416
 417          return Result;
 418       end Append;
 419
 420       procedure Append
 421         (Source   : in out Bounded_String;
 422          New_Item : in Bounded_String;
 423          Drop     : in Truncation  := Error)
 424       is
 425          Llen   : constant Length_Range := Source.Length;
 426          Rlen   : constant Length_Range := New_Item.Length;
 427          Nlen   : constant Natural      := Llen + Rlen;
 428
 429       begin
 430          if Nlen <= Max_Length then
 431             Source.Length := Nlen;
 432             Source.Data (Llen + 1 .. Nlen) := New_Item.Data (1 .. Rlen);
 433
 434          else
 435             Source.Length := Max_Length;
 436
 437             case Drop is
 438                when Strings.Right =>
 439                   if Llen < Max_Length then
 440                      Source.Data (Llen + 1 .. Max_Length) :=
 441                        New_Item.Data (1 .. Max_Length - Llen);
 442                   end if;
 443
 444                when Strings.Left =>
 445                   if Rlen >= Max_Length then -- only case is Rlen = Max_Length
 446                      Source.Data := New_Item.Data;
 447
 448                   else
 449                      Source.Data (1 .. Max_Length - Rlen) :=
 450                        Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
 451                      Source.Data (Max_Length - Rlen + 1 .. Max_Length) :=
 452                        New_Item.Data (1 .. Rlen);
 453                   end if;
 454
 455                when Strings.Error =>
 456                   raise Ada.Strings.Length_Error;
 457             end case;
 458          end if;
 459
 460       end Append;
 461
 462       --  Case of Bounded_String and String
 463
 464       function Append
 465         (Left  : in Bounded_String;
 466          Right : in String;
 467          Drop  : in Strings.Truncation := Strings.Error)
 468          return  Bounded_String
 469       is
 470          Result : Bounded_String;
 471          Llen   : constant Length_Range := Left.Length;
 472          Rlen   : constant Length_Range := Right'Length;
 473          Nlen   : constant Natural      := Llen + Rlen;
 474
 475       begin
 476          if Nlen <= Max_Length then
 477             Result.Length := Nlen;
 478             Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
 479             Result.Data (Llen + 1 .. Nlen) := Right;
 480
 481          else
 482             Result.Length := Max_Length;
 483
 484             case Drop is
 485                when Strings.Right =>
 486                   if Llen >= Max_Length then -- only case is Llen = Max_Length
 487                      Result.Data := Left.Data;
 488
 489                   else
 490                      Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
 491                      Result.Data (Llen + 1 .. Max_Length) :=
 492                        Right (Right'First .. Right'First - 1 +
 493                                               Max_Length - Llen);
 494
 495                   end if;
 496
 497                when Strings.Left =>
 498                   if Rlen >= Max_Length then
 499                      Result.Data (1 .. Max_Length) :=
 500                        Right (Right'Last - (Max_Length - 1) .. Right'Last);
 501
 502                   else
 503                      Result.Data (1 .. Max_Length - Rlen) :=
 504                        Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
 505                      Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
 506                        Right;
 507                   end if;
 508
 509                when Strings.Error =>
 510                   raise Ada.Strings.Length_Error;
 511             end case;
 512          end if;
 513
 514          return Result;
 515       end Append;
 516
 517       procedure Append
 518         (Source   : in out Bounded_String;
 519          New_Item : in String;
 520          Drop     : in Truncation  := Error)
 521       is
 522          Llen   : constant Length_Range := Source.Length;
 523          Rlen   : constant Length_Range := New_Item'Length;
 524          Nlen   : constant Natural      := Llen + Rlen;
 525
 526       begin
 527          if Nlen <= Max_Length then
 528             Source.Length := Nlen;
 529             Source.Data (Llen + 1 .. Nlen) := New_Item;
 530
 531          else
 532             Source.Length := Max_Length;
 533
 534             case Drop is
 535                when Strings.Right =>
 536                   if Llen < Max_Length then
 537                      Source.Data (Llen + 1 .. Max_Length) :=
 538                        New_Item (New_Item'First ..
 539                                        New_Item'First - 1 + Max_Length - Llen);
 540                   end if;
 541
 542                when Strings.Left =>
 543                   if Rlen >= Max_Length then
 544                      Source.Data (1 .. Max_Length) :=
 545                        New_Item (New_Item'Last - (Max_Length - 1) ..
 546                                                                 New_Item'Last);
 547
 548                   else
 549                      Source.Data (1 .. Max_Length - Rlen) :=
 550                        Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
 551                      Source.Data (Max_Length - Rlen + 1 .. Max_Length) :=
 552                        New_Item;
 553                   end if;
 554
 555                when Strings.Error =>
 556                   raise Ada.Strings.Length_Error;
 557             end case;
 558          end if;
 559
 560       end Append;
 561
 562       --  Case of String and Bounded_String
 563
 564       function Append
 565         (Left  : in String;
 566          Right : in Bounded_String;
 567          Drop  : in Strings.Truncation := Strings.Error)
 568          return  Bounded_String
 569       is
 570          Result : Bounded_String;
 571          Llen   : constant Length_Range := Left'Length;
 572          Rlen   : constant Length_Range := Right.Length;
 573          Nlen   : constant Natural      := Llen + Rlen;
 574
 575       begin
 576          if Nlen <= Max_Length then
 577             Result.Length := Nlen;
 578             Result.Data (1 .. Llen) := Left;
 579             Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen);
 580
 581          else
 582             Result.Length := Max_Length;
 583
 584             case Drop is
 585                when Strings.Right =>
 586                   if Llen >= Max_Length then
 587                      Result.Data (1 .. Max_Length) :=
 588                         Left (Left'First .. Left'First + (Max_Length - 1));
 589
 590                   else
 591                      Result.Data (1 .. Llen) := Left;
 592                      Result.Data (Llen + 1 .. Max_Length) :=
 593                        Right.Data (1 .. Max_Length - Llen);
 594                   end if;
 595
 596                when Strings.Left =>
 597                   if Rlen >= Max_Length then
 598                      Result.Data (1 .. Max_Length) :=
 599                        Right.Data (Rlen - (Max_Length - 1) .. Rlen);
 600
 601                   else
 602                      Result.Data (1 .. Max_Length - Rlen) :=
 603                        Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last);
 604                      Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
 605                        Right.Data (1 .. Rlen);
 606                   end if;
 607
 608                when Strings.Error =>
 609                   raise Ada.Strings.Length_Error;
 610             end case;
 611          end if;
 612
 613          return Result;
 614       end Append;
 615
 616       --  Case of Bounded_String and Character
 617
 618       function Append
 619         (Left  : in Bounded_String;
 620          Right : in Character;
 621          Drop  : in Strings.Truncation := Strings.Error)
 622          return  Bounded_String
 623       is
 624          Result : Bounded_String;
 625          Llen   : constant Length_Range := Left.Length;
 626
 627       begin
 628          if Llen  < Max_Length then
 629             Result.Length := Llen + 1;
 630             Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
 631             Result.Data (Llen + 1) := Right;
 632             return Result;
 633
 634          else
 635             case Drop is
 636                when Strings.Right =>
 637                   return Left;
 638
 639                when Strings.Left =>
 640                   Result.Length := Max_Length;
 641                   Result.Data (1 .. Max_Length - 1) :=
 642                     Left.Data (2 .. Max_Length);
 643                   Result.Data (Max_Length) := Right;
 644                   return Result;
 645
 646                when Strings.Error =>
 647                   raise Ada.Strings.Length_Error;
 648             end case;
 649          end if;
 650       end Append;
 651
 652       procedure Append
 653         (Source   : in out Bounded_String;
 654          New_Item : in Character;
 655          Drop     : in Truncation  := Error)
 656       is
 657          Llen   : constant Length_Range := Source.Length;
 658
 659       begin
 660          if Llen  < Max_Length then
 661             Source.Length := Llen + 1;
 662             Source.Data (Llen + 1) := New_Item;
 663
 664          else
 665             Source.Length := Max_Length;
 666
 667             case Drop is
 668                when Strings.Right =>
 669                   null;
 670
 671                when Strings.Left =>
 672                   Source.Data (1 .. Max_Length - 1) :=
 673                     Source.Data (2 .. Max_Length);
 674                   Source.Data (Max_Length) := New_Item;
 675
 676                when Strings.Error =>
 677                   raise Ada.Strings.Length_Error;
 678             end case;
 679          end if;
 680
 681       end Append;
 682
 683       --  Case of Character and Bounded_String
 684
 685       function Append
 686         (Left  : in Character;
 687          Right : in Bounded_String;
 688          Drop  : in Strings.Truncation := Strings.Error)
 689          return  Bounded_String
 690       is
 691          Result : Bounded_String;
 692          Rlen   : constant Length_Range := Right.Length;
 693
 694       begin
 695          if Rlen < Max_Length then
 696             Result.Length := Rlen + 1;
 697             Result.Data (1) := Left;
 698             Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen);
 699             return Result;
 700
 701          else
 702             case Drop is
 703                when Strings.Right =>
 704                   Result.Length := Max_Length;
 705                   Result.Data (1) := Left;
 706                   Result.Data (2 .. Max_Length) :=
 707                     Right.Data (1 .. Max_Length - 1);
 708                   return Result;
 709
 710                when Strings.Left =>
 711                   return Right;
 712
 713                when Strings.Error =>
 714                   raise Ada.Strings.Length_Error;
 715             end case;
 716          end if;
 717       end Append;
 718
 719       -----------
 720       -- Count --
 721       -----------
 722
 723       function Count
 724         (Source   : in Bounded_String;
 725          Pattern  : in String;
 726          Mapping  : in Maps.Character_Mapping := Maps.Identity)
 727          return     Natural
 728       is
 729       begin
 730          return
 731            Search.Count (Source.Data (1 .. Source.Length), Pattern, Mapping);
 732       end Count;
 733
 734       function Count
 735         (Source   : in Bounded_String;
 736          Pattern  : in String;
 737          Mapping  : in Maps.Character_Mapping_Function)
 738          return     Natural
 739       is
 740       begin
 741          return
 742            Search.Count (Source.Data (1 .. Source.Length), Pattern, Mapping);
 743       end Count;
 744
 745       function Count
 746         (Source : in Bounded_String;
 747          Set    : in Maps.Character_Set)
 748          return   Natural
 749       is
 750       begin
 751          return Search.Count (Source.Data (1 .. Source.Length), Set);
 752       end Count;
 753
 754       ------------
 755       -- Delete --
 756       ------------
 757
 758       function Delete
 759         (Source  : in Bounded_String;
 760          From    : in Positive;
 761          Through : in Natural)
 762          return    Bounded_String
 763       is
 764          Slen       : constant Natural := Source.Length;
 765          Num_Delete : constant Integer := Through - From + 1;
 766          Result     : Bounded_String;
 767
 768       begin
 769          if Num_Delete <= 0 then
 770             return Source;
 771
 772          elsif From > Slen + 1 then
 773             raise Ada.Strings.Index_Error;
 774
 775          elsif Through >= Slen then
 776             Result.Length := From - 1;
 777             Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
 778             return Result;
 779
 780          else
 781             Result.Length := Slen - Num_Delete;
 782             Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
 783             Result.Data (From .. Result.Length) :=
 784               Source.Data (Through + 1 .. Slen);
 785             return Result;
 786          end if;
 787       end Delete;
 788
 789       procedure Delete
 790         (Source  : in out Bounded_String;
 791          From    : in Positive;
 792          Through : in Natural)
 793       is
 794          Slen       : constant Natural := Source.Length;
 795          Num_Delete : constant Integer := Through - From + 1;
 796
 797       begin
 798          if Num_Delete <= 0 then
 799             return;
 800
 801          elsif From > Slen + 1 then
 802             raise Ada.Strings.Index_Error;
 803
 804          elsif Through >= Slen then
 805             Source.Length := From - 1;
 806
 807          else
 808             Source.Length := Slen - Num_Delete;
 809             Source.Data (From .. Source.Length) :=
 810               Source.Data (Through + 1 .. Slen);
 811          end if;
 812       end Delete;
 813
 814       -------------
 815       -- Element --
 816       -------------
 817
 818       function Element
 819         (Source : in Bounded_String;
 820          Index  : in Positive)
 821          return   Character
 822       is
 823       begin
 824          if Index in 1 .. Source.Length then
 825             return Source.Data (Index);
 826          else
 827             raise Strings.Index_Error;
 828          end if;
 829       end Element;
 830
 831       ----------------
 832       -- Find_Token --
 833       ----------------
 834
 835       procedure Find_Token
 836         (Source : in Bounded_String;
 837          Set    : in Maps.Character_Set;
 838          Test   : in Strings.Membership;
 839          First  : out Positive;
 840          Last   : out Natural)
 841       is
 842       begin
 843          Search.Find_Token
 844            (Source.Data (1 .. Source.Length), Set, Test, First, Last);
 845       end Find_Token;
 846
 847
 848       ----------
 849       -- Head --
 850       ----------
 851
 852       function Head
 853         (Source : in Bounded_String;
 854          Count  : in Natural;
 855          Pad    : in Character := Space;
 856          Drop   : in Strings.Truncation := Strings.Error)
 857          return   Bounded_String
 858       is
 859          Result : Bounded_String;
 860          Slen   : constant Natural := Source.Length;
 861          Npad   : constant Integer := Count - Slen;
 862
 863       begin
 864          if Npad <= 0 then
 865             Result.Length := Count;
 866             Result.Data (1 .. Count) := Source.Data (1 .. Count);
 867
 868          elsif Count <= Max_Length then
 869             Result.Length := Count;
 870             Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
 871             Result.Data (Slen + 1 .. Count) := (others => Pad);
 872
 873          else
 874             Result.Length := Max_Length;
 875
 876             case Drop is
 877                when Strings.Right =>
 878                   Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
 879                   Result.Data (Slen + 1 .. Max_Length) := (others => Pad);
 880
 881                when Strings.Left =>
 882                   if Npad >= Max_Length then
 883                      Result.Data := (others => Pad);
 884
 885                   else
 886                      Result.Data (1 .. Max_Length - Npad) :=
 887                        Source.Data (Count - Max_Length + 1 .. Slen);
 888                      Result.Data (Max_Length - Npad + 1 .. Max_Length) :=
 889                        (others => Pad);
 890                   end if;
 891
 892                when Strings.Error =>
 893                   raise Ada.Strings.Length_Error;
 894             end case;
 895          end if;
 896
 897          return Result;
 898       end Head;
 899
 900       procedure Head
 901         (Source : in out Bounded_String;
 902          Count  : in Natural;
 903          Pad    : in Character  := Space;
 904          Drop   : in Truncation := Error)
 905       is
 906          Slen   : constant Natural := Source.Length;
 907          Npad   : constant Integer := Count - Slen;
 908          Temp   : String (1 .. Max_Length);
 909
 910       begin
 911          if Npad <= 0 then
 912             Source.Length := Count;
 913
 914          elsif Count <= Max_Length then
 915             Source.Length := Count;
 916             Source.Data (Slen + 1 .. Count) := (others => Pad);
 917
 918          else
 919             Source.Length := Max_Length;
 920
 921             case Drop is
 922                when Strings.Right =>
 923                   Source.Data (Slen + 1 .. Max_Length) := (others => Pad);
 924
 925                when Strings.Left =>
 926                   if Npad > Max_Length then
 927                      Source.Data := (others => Pad);
 928
 929                   else
 930                      Temp := Source.Data;
 931                      Source.Data (1 .. Max_Length - Npad) :=
 932                        Temp (Count - Max_Length + 1 .. Slen);
 933
 934                      for J in Max_Length - Npad + 1 .. Max_Length loop
 935                         Source.Data (J) := Pad;
 936                      end loop;
 937                   end if;
 938
 939                when Strings.Error =>
 940                   raise Ada.Strings.Length_Error;
 941             end case;
 942          end if;
 943
 944       end Head;
 945
 946       -----------
 947       -- Index --
 948       -----------
 949
 950       function Index
 951         (Source   : in Bounded_String;
 952          Pattern  : in String;
 953          Going    : in Strings.Direction := Strings.Forward;
 954          Mapping  : in Maps.Character_Mapping := Maps.Identity)
 955          return     Natural
 956       is
 957       begin
 958          return Search.Index
 959            (Source.Data (1 .. Source.Length), Pattern, Going, Mapping);
 960       end Index;
 961
 962       function Index
 963         (Source   : in Bounded_String;
 964          Pattern  : in String;
 965          Going    : in Direction := Forward;
 966          Mapping  : in Maps.Character_Mapping_Function)
 967          return     Natural
 968       is
 969       begin
 970          return Search.Index
 971            (Source.Data (1 .. Source.Length), Pattern, Going, Mapping);
 972       end Index;
 973
 974       function Index
 975         (Source : in Bounded_String;
 976          Set    : in Maps.Character_Set;
 977          Test   : in Strings.Membership := Strings.Inside;
 978          Going  : in Strings.Direction  := Strings.Forward)
 979          return   Natural
 980       is
 981       begin
 982          return Search.Index
 983            (Source.Data (1 .. Source.Length), Set, Test, Going);
 984       end Index;
 985
 986       ---------------------
 987       -- Index_Non_Blank --
 988       ---------------------
 989
 990       function Index_Non_Blank
 991         (Source : in Bounded_String;
 992          Going  : in Strings.Direction := Strings.Forward)
 993          return   Natural
 994       is
 995       begin
 996          return
 997            Search.Index_Non_Blank (Source.Data (1 .. Source.Length), Going);
 998       end Index_Non_Blank;
 999
1000       ------------
1001       -- Insert --
1002       ------------
1003
1004       function Insert
1005         (Source   : in Bounded_String;
1006          Before   : in Positive;
1007          New_Item : in String;
1008          Drop     : in Strings.Truncation := Strings.Error)
1009          return     Bounded_String
1010       is
1011          Slen    : constant Natural := Source.Length;
1012          Nlen    : constant Natural := New_Item'Length;
1013          Tlen    : constant Natural := Slen + Nlen;
1014          Blen    : constant Natural := Before - 1;
1015          Alen    : constant Integer := Slen - Blen;
1016          Droplen : constant Integer := Tlen - Max_Length;
1017          Result  : Bounded_String;
1018
1019          --  Tlen is the length of the total string before possible truncation.
1020          --  Blen, Alen are the lengths of the before and after pieces of the
1021          --  source string.
1022
1023       begin
1024          if Alen < 0 then
1025             raise Ada.Strings.Index_Error;
1026
1027          elsif Droplen <= 0 then
1028             Result.Length := Tlen;
1029             Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1030             Result.Data (Before .. Before + Nlen - 1) := New_Item;
1031             Result.Data (Before + Nlen .. Tlen) :=
1032               Source.Data (Before .. Slen);
1033
1034          else
1035             Result.Length := Max_Length;
1036
1037             case Drop is
1038                when Strings.Right =>
1039                   Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1040
1041                   if Droplen > Alen then
1042                      Result.Data (Before .. Max_Length) :=
1043                        New_Item (New_Item'First
1044                                    .. New_Item'First + Max_Length - Before);
1045                   else
1046                      Result.Data (Before .. Before + Nlen - 1) := New_Item;
1047                      Result.Data (Before + Nlen .. Max_Length) :=
1048                        Source.Data (Before .. Slen - Droplen);
1049                   end if;
1050
1051                when Strings.Left =>
1052                   Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1053                     Source.Data (Before .. Slen);
1054
1055                   if Droplen >= Blen then
1056                      Result.Data (1 .. Max_Length - Alen) :=
1057                        New_Item (New_Item'Last - (Max_Length - Alen) + 1
1058                                    .. New_Item'Last);
1059                   else
1060                      Result.Data
1061                        (Blen - Droplen + 1 .. Max_Length - Alen) :=
1062                          New_Item;
1063                      Result.Data (1 .. Blen - Droplen) :=
1064                        Source.Data (Droplen + 1 .. Blen);
1065                   end if;
1066
1067                when Strings.Error =>
1068                   raise Ada.Strings.Length_Error;
1069             end case;
1070          end if;
1071
1072          return Result;
1073       end Insert;
1074
1075       procedure Insert
1076         (Source   : in out Bounded_String;
1077          Before   : in Positive;
1078          New_Item : in String;
1079          Drop     : in Strings.Truncation := Strings.Error)
1080       is
1081       begin
1082          --  We do a double copy here because this is one of the situations
1083          --  in which we move data to the right, and at least at the moment,
1084          --  GNAT is not handling such cases correctly ???
1085
1086          Source := Insert (Source, Before, New_Item, Drop);
1087       end Insert;
1088
1089       ------------
1090       -- Length --
1091       ------------
1092
1093       function Length (Source : in Bounded_String) return Length_Range is
1094       begin
1095          return Source.Length;
1096       end Length;
1097
1098       ---------------
1099       -- Overwrite --
1100       ---------------
1101
1102       function Overwrite
1103         (Source    : in Bounded_String;
1104          Position  : in Positive;
1105          New_Item  : in String;
1106          Drop      : in Strings.Truncation := Strings.Error)
1107          return      Bounded_String
1108       is
1109          Result  : Bounded_String;
1110          Endpos  : constant Natural  := Position + New_Item'Length - 1;
1111          Slen    : constant Natural  := Source.Length;
1112          Droplen : Natural;
1113
1114       begin
1115          if Position > Slen + 1 then
1116             raise Ada.Strings.Index_Error;
1117
1118          elsif New_Item'Length = 0 then
1119             return Source;
1120
1121          elsif Endpos <= Slen then
1122             Result.Length := Source.Length;
1123             Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
1124             Result.Data (Position .. Endpos) := New_Item;
1125             return Result;
1126
1127          elsif Endpos <= Max_Length then
1128             Result.Length := Endpos;
1129             Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1);
1130             Result.Data (Position .. Endpos) := New_Item;
1131             return Result;
1132
1133          else
1134             Result.Length := Max_Length;
1135             Droplen := Endpos - Max_Length;
1136
1137             case Drop is
1138                when Strings.Right =>
1139                   Result.Data (1 .. Position - 1) :=
1140                     Source.Data (1 .. Position - 1);
1141
1142                   Result.Data (Position .. Max_Length) :=
1143                     New_Item (New_Item'First .. New_Item'Last - Droplen);
1144                   return Result;
1145
1146                when Strings.Left =>
1147                   if New_Item'Length >= Max_Length then
1148                      Result.Data (1 .. Max_Length) :=
1149                         New_Item (New_Item'Last - Max_Length + 1 ..
1150                                   New_Item'Last);
1151                      return Result;
1152
1153                   else
1154                      Result.Data (1 .. Max_Length - New_Item'Length) :=
1155                        Source.Data (Droplen + 1 .. Position - 1);
1156                      Result.Data
1157                        (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1158                          New_Item;
1159                      return Result;
1160                   end if;
1161
1162                when Strings.Error =>
1163                   raise Ada.Strings.Length_Error;
1164             end case;
1165          end if;
1166       end Overwrite;
1167
1168       procedure Overwrite
1169         (Source    : in out Bounded_String;
1170          Position  : in Positive;
1171          New_Item  : in String;
1172          Drop      : in Strings.Truncation := Strings.Error)
1173       is
1174          Endpos  : constant Positive := Position + New_Item'Length - 1;
1175          Slen    : constant Natural  := Source.Length;
1176          Droplen : Natural;
1177
1178       begin
1179          if Position > Slen + 1 then
1180             raise Ada.Strings.Index_Error;
1181
1182          elsif Endpos <= Slen then
1183             Source.Data (Position .. Endpos) := New_Item;
1184
1185          elsif Endpos <= Max_Length then
1186             Source.Data (Position .. Endpos) := New_Item;
1187             Source.Length := Endpos;
1188
1189          else
1190             Source.Length := Max_Length;
1191             Droplen := Endpos - Max_Length;
1192
1193             case Drop is
1194                when Strings.Right =>
1195                   Source.Data (Position .. Max_Length) :=
1196                     New_Item (New_Item'First .. New_Item'Last - Droplen);
1197
1198                when Strings.Left =>
1199                   if New_Item'Length > Max_Length then
1200                      Source.Data (1 .. Max_Length) :=
1201                         New_Item (New_Item'Last - Max_Length + 1 ..
1202                                   New_Item'Last);
1203
1204                   else
1205                      Source.Data (1 .. Max_Length - New_Item'Length) :=
1206                        Source.Data (Droplen + 1 .. Position - 1);
1207
1208                      Source.Data
1209                        (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1210                          New_Item;
1211                   end if;
1212
1213                when Strings.Error =>
1214                   raise Ada.Strings.Length_Error;
1215             end case;
1216          end if;
1217       end Overwrite;
1218
1219       ---------------------
1220       -- Replace_Element --
1221       ---------------------
1222
1223       procedure Replace_Element
1224         (Source : in out Bounded_String;
1225          Index  : in Positive;
1226          By     : in Character)
1227       is
1228       begin
1229          if Index <= Source.Length then
1230             Source.Data (Index) := By;
1231          else
1232             raise Ada.Strings.Index_Error;
1233          end if;
1234       end Replace_Element;
1235
1236       -------------------
1237       -- Replace_Slice --
1238       -------------------
1239
1240       function Replace_Slice
1241         (Source   : in Bounded_String;
1242          Low      : in Positive;
1243          High     : in Natural;
1244          By       : in String;
1245          Drop     : in Strings.Truncation := Strings.Error)
1246          return     Bounded_String
1247       is
1248          Slen : constant Natural := Source.Length;
1249
1250       begin
1251          if Low > Slen + 1 then
1252             raise Strings.Index_Error;
1253
1254          elsif High < Low then
1255             return Insert (Source, Low, By, Drop);
1256
1257          else
1258             declare
1259                Blen    : constant Natural := Natural'Max (0, Low - 1);
1260                Alen    : constant Natural := Natural'Max (0, Slen - High);
1261                Tlen    : constant Natural := Blen + By'Length + Alen;
1262                Droplen : constant Integer := Tlen - Max_Length;
1263                Result  : Bounded_String;
1264
1265                --  Tlen is the total length of the result string before any
1266                --  truncation. Blen and Alen are the lengths of the pieces
1267                --  of the original string that end up in the result string
1268                --  before and after the replaced slice.
1269
1270             begin
1271                if Droplen <= 0 then
1272                   Result.Length := Tlen;
1273                   Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1274                   Result.Data (Low .. Low + By'Length - 1) := By;
1275                   Result.Data (Low + By'Length .. Tlen) :=
1276                     Source.Data (High + 1 .. Slen);
1277
1278                else
1279                   Result.Length := Max_Length;
1280
1281                   case Drop is
1282                      when Strings.Right =>
1283                         Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1284
1285                         if Droplen > Alen then
1286                            Result.Data (Low .. Max_Length) :=
1287                              By (By'First .. By'First + Max_Length - Low);
1288                         else
1289                            Result.Data (Low .. Low + By'Length - 1) := By;
1290                            Result.Data (Low + By'Length .. Max_Length) :=
1291                              Source.Data (High + 1 .. Slen - Droplen);
1292                         end if;
1293
1294                      when Strings.Left =>
1295                         Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1296                           Source.Data (High + 1 .. Slen);
1297
1298                         if Droplen >= Blen then
1299                            Result.Data (1 .. Max_Length - Alen) :=
1300                              By (By'Last - (Max_Length - Alen) + 1 .. By'Last);
1301                         else
1302                            Result.Data
1303                              (Blen - Droplen + 1 .. Max_Length - Alen) := By;
1304                            Result.Data (1 .. Blen - Droplen) :=
1305                              Source.Data (Droplen + 1 .. Blen);
1306                         end if;
1307
1308                      when Strings.Error =>
1309                         raise Ada.Strings.Length_Error;
1310                   end case;
1311                end if;
1312
1313                return Result;
1314             end;
1315          end if;
1316       end Replace_Slice;
1317
1318       procedure Replace_Slice
1319         (Source   : in out Bounded_String;
1320          Low      : in Positive;
1321          High     : in Natural;
1322          By       : in String;
1323          Drop     : in Strings.Truncation := Strings.Error)
1324       is
1325       begin
1326          --  We do a double copy here because this is one of the situations
1327          --  in which we move data to the right, and at least at the moment,
1328          --  GNAT is not handling such cases correctly ???
1329
1330          Source := Replace_Slice (Source, Low, High, By, Drop);
1331       end Replace_Slice;
1332
1333       ---------------
1334       -- Replicate --
1335       ---------------
1336
1337       function Replicate
1338         (Count : in Natural;
1339          Item  : in Character;
1340          Drop  : in Strings.Truncation := Strings.Error)
1341          return  Bounded_String
1342       is
1343          Result : Bounded_String;
1344
1345       begin
1346          if Count <= Max_Length then
1347             Result.Length := Count;
1348
1349          elsif Drop = Strings.Error then
1350             raise Ada.Strings.Length_Error;
1351
1352          else
1353             Result.Length := Max_Length;
1354          end if;
1355
1356          Result.Data (1 .. Result.Length) := (others => Item);
1357          return Result;
1358       end Replicate;
1359
1360       function Replicate
1361         (Count : in Natural;
1362          Item  : in String;
1363          Drop  : in Strings.Truncation := Strings.Error)
1364          return  Bounded_String
1365       is
1366          Length : constant Integer := Count * Item'Length;
1367          Result : Bounded_String;
1368          Indx   : Positive;
1369
1370       begin
1371          if Length <= Max_Length then
1372             Result.Length := Length;
1373
1374             if Length > 0 then
1375                Indx := 1;
1376
1377                for J in 1 .. Count loop
1378                   Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1379                   Indx := Indx + Item'Length;
1380                end loop;
1381             end if;
1382
1383          else
1384             Result.Length := Max_Length;
1385
1386             case Drop is
1387                when Strings.Right =>
1388                   Indx := 1;
1389
1390                   while Indx + Item'Length <= Max_Length + 1 loop
1391                      Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1392                      Indx := Indx + Item'Length;
1393                   end loop;
1394
1395                   Result.Data (Indx .. Max_Length) :=
1396                     Item (Item'First .. Item'First + Max_Length - Indx);
1397
1398                when Strings.Left =>
1399                   Indx := Max_Length;
1400
1401                   while Indx - Item'Length >= 1 loop
1402                      Result.Data (Indx - (Item'Length - 1) .. Indx) := Item;
1403                      Indx := Indx - Item'Length;
1404                   end loop;
1405
1406                   Result.Data (1 .. Indx) :=
1407                     Item (Item'Last - Indx + 1 .. Item'Last);
1408
1409                when Strings.Error =>
1410                   raise Ada.Strings.Length_Error;
1411             end case;
1412          end if;
1413
1414          return Result;
1415       end Replicate;
1416
1417       function Replicate
1418         (Count : in Natural;
1419          Item  : in Bounded_String;
1420          Drop  : in Strings.Truncation := Strings.Error)
1421          return  Bounded_String
1422       is
1423       begin
1424          return Replicate (Count, Item.Data (1 .. Item.Length), Drop);
1425       end Replicate;
1426
1427       -----------
1428       -- Slice --
1429       -----------
1430
1431       function Slice
1432         (Source : Bounded_String;
1433          Low    : Positive;
1434          High   : Natural)
1435          return   String
1436       is
1437       begin
1438          --  Note: test of High > Length is in accordance with AI95-00128
1439
1440          if Low > Source.Length + 1 or else High > Source.Length then
1441             raise Index_Error;
1442          else
1443             return Source.Data (Low .. High);
1444          end if;
1445       end Slice;
1446
1447       ----------
1448       -- Tail --
1449       ----------
1450
1451       function Tail
1452         (Source : in Bounded_String;
1453          Count  : in Natural;
1454          Pad    : in Character := Space;
1455          Drop   : in Strings.Truncation := Strings.Error)
1456          return   Bounded_String
1457       is
1458          Result : Bounded_String;
1459          Slen   : constant Natural := Source.Length;
1460          Npad   : constant Integer := Count - Slen;
1461
1462       begin
1463          if Npad <= 0 then
1464             Result.Length := Count;
1465             Result.Data (1 .. Count) :=
1466               Source.Data (Slen - (Count - 1) .. Slen);
1467
1468          elsif Count <= Max_Length then
1469             Result.Length := Count;
1470             Result.Data (1 .. Npad) := (others => Pad);
1471             Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1472
1473          else
1474             Result.Length := Max_Length;
1475
1476             case Drop is
1477                when Strings.Right =>
1478                   if Npad >= Max_Length then
1479                      Result.Data := (others => Pad);
1480
1481                   else
1482                      Result.Data (1 .. Npad) := (others => Pad);
1483                      Result.Data (Npad + 1 .. Max_Length) :=
1484                        Source.Data (1 .. Max_Length - Npad);
1485                   end if;
1486
1487                when Strings.Left =>
1488                   Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1489                   Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1490                     Source.Data (1 .. Slen);
1491
1492                when Strings.Error =>
1493                   raise Ada.Strings.Length_Error;
1494             end case;
1495          end if;
1496
1497          return Result;
1498       end Tail;
1499
1500       procedure Tail
1501         (Source : in out Bounded_String;
1502          Count  : in Natural;
1503          Pad    : in Character  := Space;
1504          Drop   : in Truncation := Error)
1505       is
1506          Slen   : constant Natural := Source.Length;
1507          Npad   : constant Integer := Count - Slen;
1508          Temp   : String (1 .. Max_Length) := Source.Data;
1509
1510       begin
1511          if Npad <= 0 then
1512             Source.Length := Count;
1513             Source.Data (1 .. Count) :=
1514               Temp (Slen - (Count - 1) .. Slen);
1515
1516          elsif Count <= Max_Length then
1517             Source.Length := Count;
1518             Source.Data (1 .. Npad) := (others => Pad);
1519             Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1520
1521          else
1522             Source.Length := Max_Length;
1523
1524             case Drop is
1525                when Strings.Right =>
1526                   if Npad >= Max_Length then
1527                      Source.Data := (others => Pad);
1528
1529                   else
1530                      Source.Data (1 .. Npad) := (others => Pad);
1531                      Source.Data (Npad + 1 .. Max_Length) :=
1532                        Temp (1 .. Max_Length - Npad);
1533                   end if;
1534
1535                when Strings.Left =>
1536                   for J in 1 .. Max_Length - Slen loop
1537                      Source.Data (J) := Pad;
1538                   end loop;
1539
1540                   Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1541                     Temp (1 .. Slen);
1542
1543                when Strings.Error =>
1544                   raise Ada.Strings.Length_Error;
1545             end case;
1546          end if;
1547
1548       end Tail;
1549
1550       -----------------------
1551       -- To_Bounded_String --
1552       -----------------------
1553
1554       function To_Bounded_String
1555         (Source : in String;
1556          Drop   : in Strings.Truncation := Strings.Error)
1557          return   Bounded_String
1558       is
1559          Slen   : constant Natural := Source'Length;
1560          Result : Bounded_String;
1561
1562       begin
1563          if Slen <= Max_Length then
1564             Result.Length := Slen;
1565             Result.Data (1 .. Slen) := Source;
1566
1567          else
1568             case Drop is
1569                when Strings.Right =>
1570                   Result.Length := Max_Length;
1571                   Result.Data (1 .. Max_Length) :=
1572                     Source (Source'First .. Source'First - 1 + Max_Length);
1573
1574                when Strings.Left =>
1575                   Result.Length := Max_Length;
1576                   Result.Data (1 .. Max_Length) :=
1577                     Source (Source'Last - (Max_Length - 1) .. Source'Last);
1578
1579                when Strings.Error =>
1580                   raise Ada.Strings.Length_Error;
1581             end case;
1582          end if;
1583
1584          return Result;
1585       end To_Bounded_String;
1586
1587       ---------------
1588       -- To_String --
1589       ---------------
1590
1591       function To_String (Source : in Bounded_String) return String is
1592       begin
1593          return Source.Data (1 .. Source.Length);
1594       end To_String;
1595
1596       ---------------
1597       -- Translate --
1598       ---------------
1599
1600       function Translate
1601         (Source  : in Bounded_String;
1602          Mapping : in Maps.Character_Mapping)
1603          return    Bounded_String
1604       is
1605          Result : Bounded_String;
1606
1607       begin
1608          Result.Length := Source.Length;
1609
1610          for J in 1 .. Source.Length loop
1611             Result.Data (J) := Value (Mapping, Source.Data (J));
1612          end loop;
1613
1614          return Result;
1615       end Translate;
1616
1617       procedure Translate
1618         (Source  : in out Bounded_String;
1619          Mapping : in Maps.Character_Mapping)
1620       is
1621       begin
1622          for J in 1 .. Source.Length loop
1623             Source.Data (J) := Value (Mapping, Source.Data (J));
1624          end loop;
1625       end Translate;
1626
1627       function Translate
1628         (Source  : in Bounded_String;
1629          Mapping : in Maps.Character_Mapping_Function)
1630          return Bounded_String
1631       is
1632          Result : Bounded_String;
1633
1634       begin
1635          Result.Length := Source.Length;
1636
1637          for J in 1 .. Source.Length loop
1638             Result.Data (J) := Mapping.all (Source.Data (J));
1639          end loop;
1640
1641          return Result;
1642       end Translate;
1643
1644       procedure Translate
1645         (Source  : in out Bounded_String;
1646          Mapping : in Maps.Character_Mapping_Function)
1647       is
1648       begin
1649          for J in 1 .. Source.Length loop
1650             Source.Data (J) := Mapping.all (Source.Data (J));
1651          end loop;
1652       end Translate;
1653
1654       ----------
1655       -- Trim --
1656       ----------
1657
1658       function Trim (Source : in Bounded_String; Side : in Trim_End)
1659          return Bounded_String
1660       is
1661          Result : Bounded_String;
1662          Last   : Natural := Source.Length;
1663          First  : Positive := 1;
1664
1665       begin
1666          if Side = Left or else Side = Both then
1667             while First <= Last and then Source.Data (First) = ' ' loop
1668                First := First + 1;
1669             end loop;
1670          end if;
1671
1672          if Side = Right or else Side = Both then
1673             while Last >= First and then Source.Data (Last) = ' ' loop
1674                Last := Last - 1;
1675             end loop;
1676          end if;
1677
1678          Result.Length := Last - First + 1;
1679          Result.Data (1 .. Result.Length) := Source.Data (First .. Last);
1680          return Result;
1681
1682       end Trim;
1683
1684       procedure Trim
1685         (Source : in out Bounded_String;
1686          Side   : in Trim_End)
1687       is
1688          Last   : Length_Range := Source.Length;
1689          First  : Positive     := 1;
1690          Temp   : String (1 .. Max_Length);
1691
1692       begin
1693          Temp (1 .. Last) := Source.Data (1 .. Last);
1694
1695          if Side = Left or else Side = Both then
1696             while First <= Last and then Temp (First) = ' ' loop
1697                First := First + 1;
1698             end loop;
1699          end if;
1700
1701          if Side = Right or else Side = Both then
1702             while Last >= First and then Temp (Last) = ' ' loop
1703                Last := Last - 1;
1704             end loop;
1705          end if;
1706
1707          Source := Null_Bounded_String;
1708          Source.Length := Last - First + 1;
1709          Source.Data (1 .. Source.Length) := Temp (First .. Last);
1710
1711       end Trim;
1712
1713       function Trim
1714         (Source : in Bounded_String;
1715          Left   : in Maps.Character_Set;
1716          Right  : in Maps.Character_Set)
1717          return   Bounded_String
1718       is
1719          Result : Bounded_String;
1720
1721       begin
1722          for First in 1 .. Source.Length loop
1723             if not Is_In (Source.Data (First), Left) then
1724                for Last in reverse First .. Source.Length loop
1725                   if not Is_In (Source.Data (Last), Right) then
1726                      Result.Length := Last - First + 1;
1727                      Result.Data (1 .. Result.Length) :=
1728                         Source.Data (First .. Last);
1729                      return Result;
1730                   end if;
1731                end loop;
1732             end if;
1733          end loop;
1734
1735          Result.Length := 0;
1736          return Result;
1737       end Trim;
1738
1739       procedure Trim
1740         (Source : in out Bounded_String;
1741          Left   : in Maps.Character_Set;
1742          Right  : in Maps.Character_Set)
1743       is
1744       begin
1745          for First in 1 .. Source.Length loop
1746             if not Is_In (Source.Data (First), Left) then
1747                for Last in reverse First .. Source.Length loop
1748                   if not Is_In (Source.Data (Last), Right) then
1749                      if First = 1 then
1750                         Source.Length := Last;
1751                         return;
1752                      else
1753                         Source.Length := Last - First + 1;
1754                         Source.Data (1 .. Source.Length) :=
1755                           Source.Data (First .. Last);
1756
1757                         for J in Source.Length + 1 .. Max_Length loop
1758                            Source.Data (J) := ASCII.NUL;
1759                         end loop;
1760
1761                         return;
1762                      end if;
1763                   end if;
1764                end loop;
1765
1766                Source.Length := 0;
1767                return;
1768             end if;
1769          end loop;
1770
1771          Source.Length := 0;
1772       end Trim;
1773
1774    end Generic_Bounded_Length;
1775
1776 end Ada.Strings.Bounded;