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