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