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