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