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