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-2014, 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_Search; 33with Ada.Unchecked_Deallocation; 34 35package body Ada.Strings.Wide_Wide_Unbounded is 36 37 use Ada.Strings.Wide_Wide_Maps; 38 39 Growth_Factor : constant := 32; 40 -- The growth factor controls how much extra space is allocated when 41 -- we have to increase the size of an allocated unbounded string. By 42 -- allocating extra space, we avoid the need to reallocate on every 43 -- append, particularly important when a string is built up by repeated 44 -- append operations of small pieces. This is expressed as a factor so 45 -- 32 means add 1/32 of the length of the string as growth space. 46 47 Min_Mul_Alloc : constant := Standard'Maximum_Alignment; 48 -- Allocation will be done by a multiple of Min_Mul_Alloc. This causes 49 -- no memory loss as most (all?) malloc implementations are obliged to 50 -- align the returned memory on the maximum alignment as malloc does not 51 -- know the target alignment. 52 53 function Aligned_Max_Length (Max_Length : Natural) return Natural; 54 -- Returns recommended length of the shared string which is greater or 55 -- equal to specified length. Calculation take in sense alignment of 56 -- the allocated memory segments to use memory effectively by 57 -- Append/Insert/etc operations. 58 59 --------- 60 -- "&" -- 61 --------- 62 63 function "&" 64 (Left : Unbounded_Wide_Wide_String; 65 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String 66 is 67 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 68 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 69 DL : constant Natural := LR.Last + RR.Last; 70 DR : Shared_Wide_Wide_String_Access; 71 72 begin 73 -- Result is an empty string, reuse shared empty string 74 75 if DL = 0 then 76 Reference (Empty_Shared_Wide_Wide_String'Access); 77 DR := Empty_Shared_Wide_Wide_String'Access; 78 79 -- Left string is empty, return Rigth string 80 81 elsif LR.Last = 0 then 82 Reference (RR); 83 DR := RR; 84 85 -- Right string is empty, return Left string 86 87 elsif RR.Last = 0 then 88 Reference (LR); 89 DR := LR; 90 91 -- Overwise, allocate new shared string and fill data 92 93 else 94 DR := Allocate (DL); 95 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 96 DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last); 97 DR.Last := DL; 98 end if; 99 100 return (AF.Controlled with Reference => DR); 101 end "&"; 102 103 function "&" 104 (Left : Unbounded_Wide_Wide_String; 105 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String 106 is 107 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 108 DL : constant Natural := LR.Last + Right'Length; 109 DR : Shared_Wide_Wide_String_Access; 110 111 begin 112 -- Result is an empty string, reuse shared empty string 113 114 if DL = 0 then 115 Reference (Empty_Shared_Wide_Wide_String'Access); 116 DR := Empty_Shared_Wide_Wide_String'Access; 117 118 -- Right is an empty string, return Left string 119 120 elsif Right'Length = 0 then 121 Reference (LR); 122 DR := LR; 123 124 -- Otherwise, allocate new shared string and fill it 125 126 else 127 DR := Allocate (DL); 128 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 129 DR.Data (LR.Last + 1 .. DL) := Right; 130 DR.Last := DL; 131 end if; 132 133 return (AF.Controlled with Reference => DR); 134 end "&"; 135 136 function "&" 137 (Left : Wide_Wide_String; 138 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String 139 is 140 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 141 DL : constant Natural := Left'Length + RR.Last; 142 DR : Shared_Wide_Wide_String_Access; 143 144 begin 145 -- Result is an empty string, reuse shared one 146 147 if DL = 0 then 148 Reference (Empty_Shared_Wide_Wide_String'Access); 149 DR := Empty_Shared_Wide_Wide_String'Access; 150 151 -- Left is empty string, return Right string 152 153 elsif Left'Length = 0 then 154 Reference (RR); 155 DR := RR; 156 157 -- Otherwise, allocate new shared string and fill it 158 159 else 160 DR := Allocate (DL); 161 DR.Data (1 .. Left'Length) := Left; 162 DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last); 163 DR.Last := DL; 164 end if; 165 166 return (AF.Controlled with Reference => DR); 167 end "&"; 168 169 function "&" 170 (Left : Unbounded_Wide_Wide_String; 171 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String 172 is 173 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 174 DL : constant Natural := LR.Last + 1; 175 DR : Shared_Wide_Wide_String_Access; 176 177 begin 178 DR := Allocate (DL); 179 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last); 180 DR.Data (DL) := Right; 181 DR.Last := DL; 182 183 return (AF.Controlled with Reference => DR); 184 end "&"; 185 186 function "&" 187 (Left : Wide_Wide_Character; 188 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String 189 is 190 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 191 DL : constant Natural := 1 + RR.Last; 192 DR : Shared_Wide_Wide_String_Access; 193 194 begin 195 DR := Allocate (DL); 196 DR.Data (1) := Left; 197 DR.Data (2 .. DL) := RR.Data (1 .. RR.Last); 198 DR.Last := DL; 199 200 return (AF.Controlled with Reference => DR); 201 end "&"; 202 203 --------- 204 -- "*" -- 205 --------- 206 207 function "*" 208 (Left : Natural; 209 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String 210 is 211 DR : Shared_Wide_Wide_String_Access; 212 213 begin 214 -- Result is an empty string, reuse shared empty string 215 216 if Left = 0 then 217 Reference (Empty_Shared_Wide_Wide_String'Access); 218 DR := Empty_Shared_Wide_Wide_String'Access; 219 220 -- Otherwise, allocate new shared string and fill it 221 222 else 223 DR := Allocate (Left); 224 225 for J in 1 .. Left loop 226 DR.Data (J) := Right; 227 end loop; 228 229 DR.Last := Left; 230 end if; 231 232 return (AF.Controlled with Reference => DR); 233 end "*"; 234 235 function "*" 236 (Left : Natural; 237 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String 238 is 239 DL : constant Natural := Left * Right'Length; 240 DR : Shared_Wide_Wide_String_Access; 241 K : Positive; 242 243 begin 244 -- Result is an empty string, reuse shared empty string 245 246 if DL = 0 then 247 Reference (Empty_Shared_Wide_Wide_String'Access); 248 DR := Empty_Shared_Wide_Wide_String'Access; 249 250 -- Otherwise, allocate new shared string and fill it 251 252 else 253 DR := Allocate (DL); 254 K := 1; 255 256 for J in 1 .. Left loop 257 DR.Data (K .. K + Right'Length - 1) := Right; 258 K := K + Right'Length; 259 end loop; 260 261 DR.Last := DL; 262 end if; 263 264 return (AF.Controlled with Reference => DR); 265 end "*"; 266 267 function "*" 268 (Left : Natural; 269 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String 270 is 271 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 272 DL : constant Natural := Left * RR.Last; 273 DR : Shared_Wide_Wide_String_Access; 274 K : Positive; 275 276 begin 277 -- Result is an empty string, reuse shared empty string 278 279 if DL = 0 then 280 Reference (Empty_Shared_Wide_Wide_String'Access); 281 DR := Empty_Shared_Wide_Wide_String'Access; 282 283 -- Coefficient is one, just return string itself 284 285 elsif Left = 1 then 286 Reference (RR); 287 DR := RR; 288 289 -- Otherwise, allocate new shared string and fill it 290 291 else 292 DR := Allocate (DL); 293 K := 1; 294 295 for J in 1 .. Left loop 296 DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last); 297 K := K + RR.Last; 298 end loop; 299 300 DR.Last := DL; 301 end if; 302 303 return (AF.Controlled with Reference => DR); 304 end "*"; 305 306 --------- 307 -- "<" -- 308 --------- 309 310 function "<" 311 (Left : Unbounded_Wide_Wide_String; 312 Right : Unbounded_Wide_Wide_String) return Boolean 313 is 314 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 315 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 316 begin 317 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last); 318 end "<"; 319 320 function "<" 321 (Left : Unbounded_Wide_Wide_String; 322 Right : Wide_Wide_String) return Boolean 323 is 324 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 325 begin 326 return LR.Data (1 .. LR.Last) < Right; 327 end "<"; 328 329 function "<" 330 (Left : Wide_Wide_String; 331 Right : Unbounded_Wide_Wide_String) return Boolean 332 is 333 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 334 begin 335 return Left < RR.Data (1 .. RR.Last); 336 end "<"; 337 338 ---------- 339 -- "<=" -- 340 ---------- 341 342 function "<=" 343 (Left : Unbounded_Wide_Wide_String; 344 Right : Unbounded_Wide_Wide_String) return Boolean 345 is 346 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 347 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 348 349 begin 350 -- LR = RR means two strings shares shared string, thus they are equal 351 352 return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last); 353 end "<="; 354 355 function "<=" 356 (Left : Unbounded_Wide_Wide_String; 357 Right : Wide_Wide_String) return Boolean 358 is 359 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 360 begin 361 return LR.Data (1 .. LR.Last) <= Right; 362 end "<="; 363 364 function "<=" 365 (Left : Wide_Wide_String; 366 Right : Unbounded_Wide_Wide_String) return Boolean 367 is 368 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 369 begin 370 return Left <= RR.Data (1 .. RR.Last); 371 end "<="; 372 373 --------- 374 -- "=" -- 375 --------- 376 377 function "=" 378 (Left : Unbounded_Wide_Wide_String; 379 Right : Unbounded_Wide_Wide_String) return Boolean 380 is 381 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 382 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 383 384 begin 385 return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last); 386 -- LR = RR means two strings shares shared string, thus they are equal 387 end "="; 388 389 function "=" 390 (Left : Unbounded_Wide_Wide_String; 391 Right : Wide_Wide_String) return Boolean 392 is 393 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 394 begin 395 return LR.Data (1 .. LR.Last) = Right; 396 end "="; 397 398 function "=" 399 (Left : Wide_Wide_String; 400 Right : Unbounded_Wide_Wide_String) return Boolean 401 is 402 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 403 begin 404 return Left = RR.Data (1 .. RR.Last); 405 end "="; 406 407 --------- 408 -- ">" -- 409 --------- 410 411 function ">" 412 (Left : Unbounded_Wide_Wide_String; 413 Right : Unbounded_Wide_Wide_String) return Boolean 414 is 415 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 416 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 417 begin 418 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last); 419 end ">"; 420 421 function ">" 422 (Left : Unbounded_Wide_Wide_String; 423 Right : Wide_Wide_String) return Boolean 424 is 425 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 426 begin 427 return LR.Data (1 .. LR.Last) > Right; 428 end ">"; 429 430 function ">" 431 (Left : Wide_Wide_String; 432 Right : Unbounded_Wide_Wide_String) return Boolean 433 is 434 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 435 begin 436 return Left > RR.Data (1 .. RR.Last); 437 end ">"; 438 439 ---------- 440 -- ">=" -- 441 ---------- 442 443 function ">=" 444 (Left : Unbounded_Wide_Wide_String; 445 Right : Unbounded_Wide_Wide_String) return Boolean 446 is 447 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 448 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 449 450 begin 451 -- LR = RR means two strings shares shared string, thus they are equal 452 453 return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last); 454 end ">="; 455 456 function ">=" 457 (Left : Unbounded_Wide_Wide_String; 458 Right : Wide_Wide_String) return Boolean 459 is 460 LR : constant Shared_Wide_Wide_String_Access := Left.Reference; 461 begin 462 return LR.Data (1 .. LR.Last) >= Right; 463 end ">="; 464 465 function ">=" 466 (Left : Wide_Wide_String; 467 Right : Unbounded_Wide_Wide_String) return Boolean 468 is 469 RR : constant Shared_Wide_Wide_String_Access := Right.Reference; 470 begin 471 return Left >= RR.Data (1 .. RR.Last); 472 end ">="; 473 474 ------------ 475 -- Adjust -- 476 ------------ 477 478 procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is 479 begin 480 Reference (Object.Reference); 481 end Adjust; 482 483 ------------------------ 484 -- Aligned_Max_Length -- 485 ------------------------ 486 487 function Aligned_Max_Length (Max_Length : Natural) return Natural is 488 Static_Size : constant Natural := 489 Empty_Shared_Wide_Wide_String'Size / Standard'Storage_Unit; 490 -- Total size of all static components 491 492 Element_Size : constant Natural := 493 Wide_Wide_Character'Size / Standard'Storage_Unit; 494 495 begin 496 return 497 (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2) 498 * Min_Mul_Alloc - Static_Size) / Element_Size; 499 end Aligned_Max_Length; 500 501 -------------- 502 -- Allocate -- 503 -------------- 504 505 function Allocate 506 (Max_Length : Natural) return Shared_Wide_Wide_String_Access is 507 begin 508 -- Empty string requested, return shared empty string 509 510 if Max_Length = 0 then 511 Reference (Empty_Shared_Wide_Wide_String'Access); 512 return Empty_Shared_Wide_Wide_String'Access; 513 514 -- Otherwise, allocate requested space (and probably some more room) 515 516 else 517 return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length)); 518 end if; 519 end Allocate; 520 521 ------------ 522 -- Append -- 523 ------------ 524 525 procedure Append 526 (Source : in out Unbounded_Wide_Wide_String; 527 New_Item : Unbounded_Wide_Wide_String) 528 is 529 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 530 NR : constant Shared_Wide_Wide_String_Access := New_Item.Reference; 531 DL : constant Natural := SR.Last + NR.Last; 532 DR : Shared_Wide_Wide_String_Access; 533 534 begin 535 -- Source is an empty string, reuse New_Item data 536 537 if SR.Last = 0 then 538 Reference (NR); 539 Source.Reference := NR; 540 Unreference (SR); 541 542 -- New_Item is empty string, nothing to do 543 544 elsif NR.Last = 0 then 545 null; 546 547 -- Try to reuse existent shared string 548 549 elsif Can_Be_Reused (SR, DL) then 550 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); 551 SR.Last := DL; 552 553 -- Otherwise, allocate new one and fill it 554 555 else 556 DR := Allocate (DL + DL / Growth_Factor); 557 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 558 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); 559 DR.Last := DL; 560 Source.Reference := DR; 561 Unreference (SR); 562 end if; 563 end Append; 564 565 procedure Append 566 (Source : in out Unbounded_Wide_Wide_String; 567 New_Item : Wide_Wide_String) 568 is 569 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 570 DL : constant Natural := SR.Last + New_Item'Length; 571 DR : Shared_Wide_Wide_String_Access; 572 573 begin 574 -- New_Item is an empty string, nothing to do 575 576 if New_Item'Length = 0 then 577 null; 578 579 -- Try to reuse existing shared string 580 581 elsif Can_Be_Reused (SR, DL) then 582 SR.Data (SR.Last + 1 .. DL) := New_Item; 583 SR.Last := DL; 584 585 -- Otherwise, allocate new one and fill it 586 587 else 588 DR := Allocate (DL + DL / Growth_Factor); 589 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 590 DR.Data (SR.Last + 1 .. DL) := New_Item; 591 DR.Last := DL; 592 Source.Reference := DR; 593 Unreference (SR); 594 end if; 595 end Append; 596 597 procedure Append 598 (Source : in out Unbounded_Wide_Wide_String; 599 New_Item : Wide_Wide_Character) 600 is 601 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 602 DL : constant Natural := SR.Last + 1; 603 DR : Shared_Wide_Wide_String_Access; 604 605 begin 606 -- Try to reuse existing shared string 607 608 if Can_Be_Reused (SR, SR.Last + 1) then 609 SR.Data (SR.Last + 1) := New_Item; 610 SR.Last := SR.Last + 1; 611 612 -- Otherwise, allocate new one and fill it 613 614 else 615 DR := Allocate (DL + DL / Growth_Factor); 616 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 617 DR.Data (DL) := New_Item; 618 DR.Last := DL; 619 Source.Reference := DR; 620 Unreference (SR); 621 end if; 622 end Append; 623 624 ------------------- 625 -- Can_Be_Reused -- 626 ------------------- 627 628 function Can_Be_Reused 629 (Item : Shared_Wide_Wide_String_Access; 630 Length : Natural) return Boolean is 631 begin 632 return 633 System.Atomic_Counters.Is_One (Item.Counter) 634 and then Item.Max_Length >= Length 635 and then Item.Max_Length <= 636 Aligned_Max_Length (Length + Length / Growth_Factor); 637 end Can_Be_Reused; 638 639 ----------- 640 -- Count -- 641 ----------- 642 643 function Count 644 (Source : Unbounded_Wide_Wide_String; 645 Pattern : Wide_Wide_String; 646 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 647 Wide_Wide_Maps.Identity) return Natural 648 is 649 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 650 begin 651 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); 652 end Count; 653 654 function Count 655 (Source : Unbounded_Wide_Wide_String; 656 Pattern : Wide_Wide_String; 657 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 658 return Natural 659 is 660 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 661 begin 662 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping); 663 end Count; 664 665 function Count 666 (Source : Unbounded_Wide_Wide_String; 667 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural 668 is 669 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 670 begin 671 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set); 672 end Count; 673 674 ------------ 675 -- Delete -- 676 ------------ 677 678 function Delete 679 (Source : Unbounded_Wide_Wide_String; 680 From : Positive; 681 Through : Natural) return Unbounded_Wide_Wide_String 682 is 683 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 684 DL : Natural; 685 DR : Shared_Wide_Wide_String_Access; 686 687 begin 688 -- Empty slice is deleted, use the same shared string 689 690 if From > Through then 691 Reference (SR); 692 DR := SR; 693 694 -- Index is out of range 695 696 elsif Through > SR.Last then 697 raise Index_Error; 698 699 -- Compute size of the result 700 701 else 702 DL := SR.Last - (Through - From + 1); 703 704 -- Result is an empty string, reuse shared empty string 705 706 if DL = 0 then 707 Reference (Empty_Shared_Wide_Wide_String'Access); 708 DR := Empty_Shared_Wide_Wide_String'Access; 709 710 -- Otherwise, allocate new shared string and fill it 711 712 else 713 DR := Allocate (DL); 714 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1); 715 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 716 DR.Last := DL; 717 end if; 718 end if; 719 720 return (AF.Controlled with Reference => DR); 721 end Delete; 722 723 procedure Delete 724 (Source : in out Unbounded_Wide_Wide_String; 725 From : Positive; 726 Through : Natural) 727 is 728 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 729 DL : Natural; 730 DR : Shared_Wide_Wide_String_Access; 731 732 begin 733 -- Nothing changed, return 734 735 if From > Through then 736 null; 737 738 -- Through is outside of the range 739 740 elsif Through > SR.Last then 741 raise Index_Error; 742 743 else 744 DL := SR.Last - (Through - From + 1); 745 746 -- Result is empty, reuse shared empty string 747 748 if DL = 0 then 749 Reference (Empty_Shared_Wide_Wide_String'Access); 750 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 751 Unreference (SR); 752 753 -- Try to reuse existent shared string 754 755 elsif Can_Be_Reused (SR, DL) then 756 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 757 SR.Last := DL; 758 759 -- Otherwise, allocate new shared string 760 761 else 762 DR := Allocate (DL); 763 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1); 764 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last); 765 DR.Last := DL; 766 Source.Reference := DR; 767 Unreference (SR); 768 end if; 769 end if; 770 end Delete; 771 772 ------------- 773 -- Element -- 774 ------------- 775 776 function Element 777 (Source : Unbounded_Wide_Wide_String; 778 Index : Positive) return Wide_Wide_Character 779 is 780 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 781 begin 782 if Index <= SR.Last then 783 return SR.Data (Index); 784 else 785 raise Index_Error; 786 end if; 787 end Element; 788 789 -------------- 790 -- Finalize -- 791 -------------- 792 793 procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is 794 SR : constant Shared_Wide_Wide_String_Access := Object.Reference; 795 796 begin 797 if SR /= null then 798 799 -- The same controlled object can be finalized several times for 800 -- some reason. As per 7.6.1(24) this should have no ill effect, 801 -- so we need to add a guard for the case of finalizing the same 802 -- object twice. 803 804 Object.Reference := null; 805 Unreference (SR); 806 end if; 807 end Finalize; 808 809 ---------------- 810 -- Find_Token -- 811 ---------------- 812 813 procedure Find_Token 814 (Source : Unbounded_Wide_Wide_String; 815 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 816 From : Positive; 817 Test : Strings.Membership; 818 First : out Positive; 819 Last : out Natural) 820 is 821 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 822 begin 823 Wide_Wide_Search.Find_Token 824 (SR.Data (From .. SR.Last), Set, Test, First, Last); 825 end Find_Token; 826 827 procedure Find_Token 828 (Source : Unbounded_Wide_Wide_String; 829 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 830 Test : Strings.Membership; 831 First : out Positive; 832 Last : out Natural) 833 is 834 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 835 begin 836 Wide_Wide_Search.Find_Token 837 (SR.Data (1 .. SR.Last), Set, Test, First, Last); 838 end Find_Token; 839 840 ---------- 841 -- Free -- 842 ---------- 843 844 procedure Free (X : in out Wide_Wide_String_Access) is 845 procedure Deallocate is 846 new Ada.Unchecked_Deallocation 847 (Wide_Wide_String, Wide_Wide_String_Access); 848 begin 849 Deallocate (X); 850 end Free; 851 852 ---------- 853 -- Head -- 854 ---------- 855 856 function Head 857 (Source : Unbounded_Wide_Wide_String; 858 Count : Natural; 859 Pad : Wide_Wide_Character := Wide_Wide_Space) 860 return Unbounded_Wide_Wide_String 861 is 862 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 863 DR : Shared_Wide_Wide_String_Access; 864 865 begin 866 -- Result is empty, reuse shared empty string 867 868 if Count = 0 then 869 Reference (Empty_Shared_Wide_Wide_String'Access); 870 DR := Empty_Shared_Wide_Wide_String'Access; 871 872 -- Length of the string is the same as requested, reuse source shared 873 -- string. 874 875 elsif Count = SR.Last then 876 Reference (SR); 877 DR := SR; 878 879 -- Otherwise, allocate new shared string and fill it 880 881 else 882 DR := Allocate (Count); 883 884 -- Length of the source string is more than requested, copy 885 -- corresponding slice. 886 887 if Count < SR.Last then 888 DR.Data (1 .. Count) := SR.Data (1 .. Count); 889 890 -- Length of the source string is less than requested, copy all 891 -- contents and fill others by Pad character. 892 893 else 894 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 895 896 for J in SR.Last + 1 .. Count loop 897 DR.Data (J) := Pad; 898 end loop; 899 end if; 900 901 DR.Last := Count; 902 end if; 903 904 return (AF.Controlled with Reference => DR); 905 end Head; 906 907 procedure Head 908 (Source : in out Unbounded_Wide_Wide_String; 909 Count : Natural; 910 Pad : Wide_Wide_Character := Wide_Wide_Space) 911 is 912 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 913 DR : Shared_Wide_Wide_String_Access; 914 915 begin 916 -- Result is empty, reuse empty shared string 917 918 if Count = 0 then 919 Reference (Empty_Shared_Wide_Wide_String'Access); 920 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 921 Unreference (SR); 922 923 -- Result is same with source string, reuse source shared string 924 925 elsif Count = SR.Last then 926 null; 927 928 -- Try to reuse existent shared string 929 930 elsif Can_Be_Reused (SR, Count) then 931 if Count > SR.Last then 932 for J in SR.Last + 1 .. Count loop 933 SR.Data (J) := Pad; 934 end loop; 935 end if; 936 937 SR.Last := Count; 938 939 -- Otherwise, allocate new shared string and fill it 940 941 else 942 DR := Allocate (Count); 943 944 -- Length of the source string is greater than requested, copy 945 -- corresponding slice. 946 947 if Count < SR.Last then 948 DR.Data (1 .. Count) := SR.Data (1 .. Count); 949 950 -- Length of the source string is less than requested, copy all 951 -- exists data and fill others by Pad character. 952 953 else 954 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 955 956 for J in SR.Last + 1 .. Count loop 957 DR.Data (J) := Pad; 958 end loop; 959 end if; 960 961 DR.Last := Count; 962 Source.Reference := DR; 963 Unreference (SR); 964 end if; 965 end Head; 966 967 ----------- 968 -- Index -- 969 ----------- 970 971 function Index 972 (Source : Unbounded_Wide_Wide_String; 973 Pattern : Wide_Wide_String; 974 Going : Strings.Direction := Strings.Forward; 975 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 976 Wide_Wide_Maps.Identity) return Natural 977 is 978 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 979 begin 980 return Wide_Wide_Search.Index 981 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); 982 end Index; 983 984 function Index 985 (Source : Unbounded_Wide_Wide_String; 986 Pattern : Wide_Wide_String; 987 Going : Direction := Forward; 988 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 989 return Natural 990 is 991 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 992 begin 993 return Wide_Wide_Search.Index 994 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping); 995 end Index; 996 997 function Index 998 (Source : Unbounded_Wide_Wide_String; 999 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 1000 Test : Strings.Membership := Strings.Inside; 1001 Going : Strings.Direction := Strings.Forward) return Natural 1002 is 1003 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1004 begin 1005 return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going); 1006 end Index; 1007 1008 function Index 1009 (Source : Unbounded_Wide_Wide_String; 1010 Pattern : Wide_Wide_String; 1011 From : Positive; 1012 Going : Direction := Forward; 1013 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 1014 Wide_Wide_Maps.Identity) return Natural 1015 is 1016 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1017 begin 1018 return Wide_Wide_Search.Index 1019 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); 1020 end Index; 1021 1022 function Index 1023 (Source : Unbounded_Wide_Wide_String; 1024 Pattern : Wide_Wide_String; 1025 From : Positive; 1026 Going : Direction := Forward; 1027 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 1028 return Natural 1029 is 1030 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1031 begin 1032 return Wide_Wide_Search.Index 1033 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping); 1034 end Index; 1035 1036 function Index 1037 (Source : Unbounded_Wide_Wide_String; 1038 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 1039 From : Positive; 1040 Test : Membership := Inside; 1041 Going : Direction := Forward) return Natural 1042 is 1043 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1044 begin 1045 return Wide_Wide_Search.Index 1046 (SR.Data (1 .. SR.Last), Set, From, Test, Going); 1047 end Index; 1048 1049 --------------------- 1050 -- Index_Non_Blank -- 1051 --------------------- 1052 1053 function Index_Non_Blank 1054 (Source : Unbounded_Wide_Wide_String; 1055 Going : Strings.Direction := Strings.Forward) return Natural 1056 is 1057 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1058 begin 1059 return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going); 1060 end Index_Non_Blank; 1061 1062 function Index_Non_Blank 1063 (Source : Unbounded_Wide_Wide_String; 1064 From : Positive; 1065 Going : Direction := Forward) return Natural 1066 is 1067 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1068 begin 1069 return Wide_Wide_Search.Index_Non_Blank 1070 (SR.Data (1 .. SR.Last), From, Going); 1071 end Index_Non_Blank; 1072 1073 ---------------- 1074 -- Initialize -- 1075 ---------------- 1076 1077 procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is 1078 begin 1079 Reference (Object.Reference); 1080 end Initialize; 1081 1082 ------------ 1083 -- Insert -- 1084 ------------ 1085 1086 function Insert 1087 (Source : Unbounded_Wide_Wide_String; 1088 Before : Positive; 1089 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String 1090 is 1091 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1092 DL : constant Natural := SR.Last + New_Item'Length; 1093 DR : Shared_Wide_Wide_String_Access; 1094 1095 begin 1096 -- Check index first 1097 1098 if Before > SR.Last + 1 then 1099 raise Index_Error; 1100 end if; 1101 1102 -- Result is empty, reuse empty shared string 1103 1104 if DL = 0 then 1105 Reference (Empty_Shared_Wide_Wide_String'Access); 1106 DR := Empty_Shared_Wide_Wide_String'Access; 1107 1108 -- Inserted string is empty, reuse source shared string 1109 1110 elsif New_Item'Length = 0 then 1111 Reference (SR); 1112 DR := SR; 1113 1114 -- Otherwise, allocate new shared string and fill it 1115 1116 else 1117 DR := Allocate (DL + DL / Growth_Factor); 1118 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1); 1119 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item; 1120 DR.Data (Before + New_Item'Length .. DL) := 1121 SR.Data (Before .. SR.Last); 1122 DR.Last := DL; 1123 end if; 1124 1125 return (AF.Controlled with Reference => DR); 1126 end Insert; 1127 1128 procedure Insert 1129 (Source : in out Unbounded_Wide_Wide_String; 1130 Before : Positive; 1131 New_Item : Wide_Wide_String) 1132 is 1133 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1134 DL : constant Natural := SR.Last + New_Item'Length; 1135 DR : Shared_Wide_Wide_String_Access; 1136 1137 begin 1138 -- Check bounds 1139 1140 if Before > SR.Last + 1 then 1141 raise Index_Error; 1142 end if; 1143 1144 -- Result is empty string, reuse empty shared string 1145 1146 if DL = 0 then 1147 Reference (Empty_Shared_Wide_Wide_String'Access); 1148 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 1149 Unreference (SR); 1150 1151 -- Inserted string is empty, nothing to do 1152 1153 elsif New_Item'Length = 0 then 1154 null; 1155 1156 -- Try to reuse existent shared string first 1157 1158 elsif Can_Be_Reused (SR, DL) then 1159 SR.Data (Before + New_Item'Length .. DL) := 1160 SR.Data (Before .. SR.Last); 1161 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item; 1162 SR.Last := DL; 1163 1164 -- Otherwise, allocate new shared string and fill it 1165 1166 else 1167 DR := Allocate (DL + DL / Growth_Factor); 1168 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1); 1169 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item; 1170 DR.Data (Before + New_Item'Length .. DL) := 1171 SR.Data (Before .. SR.Last); 1172 DR.Last := DL; 1173 Source.Reference := DR; 1174 Unreference (SR); 1175 end if; 1176 end Insert; 1177 1178 ------------ 1179 -- Length -- 1180 ------------ 1181 1182 function Length (Source : Unbounded_Wide_Wide_String) return Natural is 1183 begin 1184 return Source.Reference.Last; 1185 end Length; 1186 1187 --------------- 1188 -- Overwrite -- 1189 --------------- 1190 1191 function Overwrite 1192 (Source : Unbounded_Wide_Wide_String; 1193 Position : Positive; 1194 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String 1195 is 1196 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1197 DL : Natural; 1198 DR : Shared_Wide_Wide_String_Access; 1199 1200 begin 1201 -- Check bounds 1202 1203 if Position > SR.Last + 1 then 1204 raise Index_Error; 1205 end if; 1206 1207 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); 1208 1209 -- Result is empty string, reuse empty shared string 1210 1211 if DL = 0 then 1212 Reference (Empty_Shared_Wide_Wide_String'Access); 1213 DR := Empty_Shared_Wide_Wide_String'Access; 1214 1215 -- Result is same with source string, reuse source shared string 1216 1217 elsif New_Item'Length = 0 then 1218 Reference (SR); 1219 DR := SR; 1220 1221 -- Otherwise, allocate new shared string and fill it 1222 1223 else 1224 DR := Allocate (DL); 1225 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1); 1226 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1227 DR.Data (Position + New_Item'Length .. DL) := 1228 SR.Data (Position + New_Item'Length .. SR.Last); 1229 DR.Last := DL; 1230 end if; 1231 1232 return (AF.Controlled with Reference => DR); 1233 end Overwrite; 1234 1235 procedure Overwrite 1236 (Source : in out Unbounded_Wide_Wide_String; 1237 Position : Positive; 1238 New_Item : Wide_Wide_String) 1239 is 1240 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1241 DL : Natural; 1242 DR : Shared_Wide_Wide_String_Access; 1243 1244 begin 1245 -- Bounds check 1246 1247 if Position > SR.Last + 1 then 1248 raise Index_Error; 1249 end if; 1250 1251 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); 1252 1253 -- Result is empty string, reuse empty shared string 1254 1255 if DL = 0 then 1256 Reference (Empty_Shared_Wide_Wide_String'Access); 1257 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 1258 Unreference (SR); 1259 1260 -- String unchanged, nothing to do 1261 1262 elsif New_Item'Length = 0 then 1263 null; 1264 1265 -- Try to reuse existent shared string 1266 1267 elsif Can_Be_Reused (SR, DL) then 1268 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1269 SR.Last := DL; 1270 1271 -- Otherwise allocate new shared string and fill it 1272 1273 else 1274 DR := Allocate (DL); 1275 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1); 1276 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item; 1277 DR.Data (Position + New_Item'Length .. DL) := 1278 SR.Data (Position + New_Item'Length .. SR.Last); 1279 DR.Last := DL; 1280 Source.Reference := DR; 1281 Unreference (SR); 1282 end if; 1283 end Overwrite; 1284 1285 --------------- 1286 -- Reference -- 1287 --------------- 1288 1289 procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is 1290 begin 1291 System.Atomic_Counters.Increment (Item.Counter); 1292 end Reference; 1293 1294 --------------------- 1295 -- Replace_Element -- 1296 --------------------- 1297 1298 procedure Replace_Element 1299 (Source : in out Unbounded_Wide_Wide_String; 1300 Index : Positive; 1301 By : Wide_Wide_Character) 1302 is 1303 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1304 DR : Shared_Wide_Wide_String_Access; 1305 1306 begin 1307 -- Bounds check 1308 1309 if Index <= SR.Last then 1310 1311 -- Try to reuse existent shared string 1312 1313 if Can_Be_Reused (SR, SR.Last) then 1314 SR.Data (Index) := By; 1315 1316 -- Otherwise allocate new shared string and fill it 1317 1318 else 1319 DR := Allocate (SR.Last); 1320 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); 1321 DR.Data (Index) := By; 1322 DR.Last := SR.Last; 1323 Source.Reference := DR; 1324 Unreference (SR); 1325 end if; 1326 1327 else 1328 raise Index_Error; 1329 end if; 1330 end Replace_Element; 1331 1332 ------------------- 1333 -- Replace_Slice -- 1334 ------------------- 1335 1336 function Replace_Slice 1337 (Source : Unbounded_Wide_Wide_String; 1338 Low : Positive; 1339 High : Natural; 1340 By : Wide_Wide_String) return Unbounded_Wide_Wide_String 1341 is 1342 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1343 DL : Natural; 1344 DR : Shared_Wide_Wide_String_Access; 1345 1346 begin 1347 -- Check bounds 1348 1349 if Low > SR.Last + 1 then 1350 raise Index_Error; 1351 end if; 1352 1353 -- Do replace operation when removed slice is not empty 1354 1355 if High >= Low then 1356 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1; 1357 -- This is the number of characters remaining in the string after 1358 -- replacing the slice. 1359 1360 -- Result is empty string, reuse empty shared string 1361 1362 if DL = 0 then 1363 Reference (Empty_Shared_Wide_Wide_String'Access); 1364 DR := Empty_Shared_Wide_Wide_String'Access; 1365 1366 -- Otherwise allocate new shared string and fill it 1367 1368 else 1369 DR := Allocate (DL); 1370 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1); 1371 DR.Data (Low .. Low + By'Length - 1) := By; 1372 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last); 1373 DR.Last := DL; 1374 end if; 1375 1376 return (AF.Controlled with Reference => DR); 1377 1378 -- Otherwise just insert string 1379 1380 else 1381 return Insert (Source, Low, By); 1382 end if; 1383 end Replace_Slice; 1384 1385 procedure Replace_Slice 1386 (Source : in out Unbounded_Wide_Wide_String; 1387 Low : Positive; 1388 High : Natural; 1389 By : Wide_Wide_String) 1390 is 1391 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1392 DL : Natural; 1393 DR : Shared_Wide_Wide_String_Access; 1394 1395 begin 1396 -- Bounds check 1397 1398 if Low > SR.Last + 1 then 1399 raise Index_Error; 1400 end if; 1401 1402 -- Do replace operation only when replaced slice is not empty 1403 1404 if High >= Low then 1405 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1; 1406 -- This is the number of characters remaining in the string after 1407 -- replacing the slice. 1408 1409 -- Result is empty string, reuse empty shared string 1410 1411 if DL = 0 then 1412 Reference (Empty_Shared_Wide_Wide_String'Access); 1413 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 1414 Unreference (SR); 1415 1416 -- Try to reuse existent shared string 1417 1418 elsif Can_Be_Reused (SR, DL) then 1419 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last); 1420 SR.Data (Low .. Low + By'Length - 1) := By; 1421 SR.Last := DL; 1422 1423 -- Otherwise allocate new shared string and fill it 1424 1425 else 1426 DR := Allocate (DL); 1427 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1); 1428 DR.Data (Low .. Low + By'Length - 1) := By; 1429 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last); 1430 DR.Last := DL; 1431 Source.Reference := DR; 1432 Unreference (SR); 1433 end if; 1434 1435 -- Otherwise just insert item 1436 1437 else 1438 Insert (Source, Low, By); 1439 end if; 1440 end Replace_Slice; 1441 1442 ------------------------------- 1443 -- Set_Unbounded_Wide_Wide_String -- 1444 ------------------------------- 1445 1446 procedure Set_Unbounded_Wide_Wide_String 1447 (Target : out Unbounded_Wide_Wide_String; 1448 Source : Wide_Wide_String) 1449 is 1450 TR : constant Shared_Wide_Wide_String_Access := Target.Reference; 1451 DR : Shared_Wide_Wide_String_Access; 1452 1453 begin 1454 -- In case of empty string, reuse empty shared string 1455 1456 if Source'Length = 0 then 1457 Reference (Empty_Shared_Wide_Wide_String'Access); 1458 Target.Reference := Empty_Shared_Wide_Wide_String'Access; 1459 1460 else 1461 -- Try to reuse existent shared string 1462 1463 if Can_Be_Reused (TR, Source'Length) then 1464 Reference (TR); 1465 DR := TR; 1466 1467 -- Otherwise allocate new shared string 1468 1469 else 1470 DR := Allocate (Source'Length); 1471 Target.Reference := DR; 1472 end if; 1473 1474 DR.Data (1 .. Source'Length) := Source; 1475 DR.Last := Source'Length; 1476 end if; 1477 1478 Unreference (TR); 1479 end Set_Unbounded_Wide_Wide_String; 1480 1481 ----------- 1482 -- Slice -- 1483 ----------- 1484 1485 function Slice 1486 (Source : Unbounded_Wide_Wide_String; 1487 Low : Positive; 1488 High : Natural) return Wide_Wide_String 1489 is 1490 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1491 1492 begin 1493 -- Note: test of High > Length is in accordance with AI95-00128 1494 1495 if Low > SR.Last + 1 or else High > SR.Last then 1496 raise Index_Error; 1497 1498 else 1499 return SR.Data (Low .. High); 1500 end if; 1501 end Slice; 1502 1503 ---------- 1504 -- Tail -- 1505 ---------- 1506 1507 function Tail 1508 (Source : Unbounded_Wide_Wide_String; 1509 Count : Natural; 1510 Pad : Wide_Wide_Character := Wide_Wide_Space) 1511 return Unbounded_Wide_Wide_String 1512 is 1513 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1514 DR : Shared_Wide_Wide_String_Access; 1515 1516 begin 1517 -- For empty result reuse empty shared string 1518 1519 if Count = 0 then 1520 Reference (Empty_Shared_Wide_Wide_String'Access); 1521 DR := Empty_Shared_Wide_Wide_String'Access; 1522 1523 -- Result is hole source string, reuse source shared string 1524 1525 elsif Count = SR.Last then 1526 Reference (SR); 1527 DR := SR; 1528 1529 -- Otherwise allocate new shared string and fill it 1530 1531 else 1532 DR := Allocate (Count); 1533 1534 if Count < SR.Last then 1535 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last); 1536 1537 else 1538 for J in 1 .. Count - SR.Last loop 1539 DR.Data (J) := Pad; 1540 end loop; 1541 1542 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last); 1543 end if; 1544 1545 DR.Last := Count; 1546 end if; 1547 1548 return (AF.Controlled with Reference => DR); 1549 end Tail; 1550 1551 procedure Tail 1552 (Source : in out Unbounded_Wide_Wide_String; 1553 Count : Natural; 1554 Pad : Wide_Wide_Character := Wide_Wide_Space) 1555 is 1556 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1557 DR : Shared_Wide_Wide_String_Access; 1558 1559 procedure Common 1560 (SR : Shared_Wide_Wide_String_Access; 1561 DR : Shared_Wide_Wide_String_Access; 1562 Count : Natural); 1563 -- Common code of tail computation. SR/DR can point to the same object 1564 1565 ------------ 1566 -- Common -- 1567 ------------ 1568 1569 procedure Common 1570 (SR : Shared_Wide_Wide_String_Access; 1571 DR : Shared_Wide_Wide_String_Access; 1572 Count : Natural) is 1573 begin 1574 if Count < SR.Last then 1575 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last); 1576 1577 else 1578 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last); 1579 1580 for J in 1 .. Count - SR.Last loop 1581 DR.Data (J) := Pad; 1582 end loop; 1583 end if; 1584 1585 DR.Last := Count; 1586 end Common; 1587 1588 begin 1589 -- Result is empty string, reuse empty shared string 1590 1591 if Count = 0 then 1592 Reference (Empty_Shared_Wide_Wide_String'Access); 1593 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 1594 Unreference (SR); 1595 1596 -- Length of the result is the same with length of the source string, 1597 -- reuse source shared string. 1598 1599 elsif Count = SR.Last then 1600 null; 1601 1602 -- Try to reuse existent shared string 1603 1604 elsif Can_Be_Reused (SR, Count) then 1605 Common (SR, SR, Count); 1606 1607 -- Otherwise allocate new shared string and fill it 1608 1609 else 1610 DR := Allocate (Count); 1611 Common (SR, DR, Count); 1612 Source.Reference := DR; 1613 Unreference (SR); 1614 end if; 1615 end Tail; 1616 1617 ------------------------- 1618 -- To_Wide_Wide_String -- 1619 ------------------------- 1620 1621 function To_Wide_Wide_String 1622 (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is 1623 begin 1624 return Source.Reference.Data (1 .. Source.Reference.Last); 1625 end To_Wide_Wide_String; 1626 1627 ----------------------------------- 1628 -- To_Unbounded_Wide_Wide_String -- 1629 ----------------------------------- 1630 1631 function To_Unbounded_Wide_Wide_String 1632 (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String 1633 is 1634 DR : Shared_Wide_Wide_String_Access; 1635 1636 begin 1637 if Source'Length = 0 then 1638 Reference (Empty_Shared_Wide_Wide_String'Access); 1639 DR := Empty_Shared_Wide_Wide_String'Access; 1640 1641 else 1642 DR := Allocate (Source'Length); 1643 DR.Data (1 .. Source'Length) := Source; 1644 DR.Last := Source'Length; 1645 end if; 1646 1647 return (AF.Controlled with Reference => DR); 1648 end To_Unbounded_Wide_Wide_String; 1649 1650 function To_Unbounded_Wide_Wide_String 1651 (Length : Natural) return Unbounded_Wide_Wide_String 1652 is 1653 DR : Shared_Wide_Wide_String_Access; 1654 1655 begin 1656 if Length = 0 then 1657 Reference (Empty_Shared_Wide_Wide_String'Access); 1658 DR := Empty_Shared_Wide_Wide_String'Access; 1659 1660 else 1661 DR := Allocate (Length); 1662 DR.Last := Length; 1663 end if; 1664 1665 return (AF.Controlled with Reference => DR); 1666 end To_Unbounded_Wide_Wide_String; 1667 1668 --------------- 1669 -- Translate -- 1670 --------------- 1671 1672 function Translate 1673 (Source : Unbounded_Wide_Wide_String; 1674 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 1675 return Unbounded_Wide_Wide_String 1676 is 1677 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1678 DR : Shared_Wide_Wide_String_Access; 1679 1680 begin 1681 -- Nothing to translate, reuse empty shared string 1682 1683 if SR.Last = 0 then 1684 Reference (Empty_Shared_Wide_Wide_String'Access); 1685 DR := Empty_Shared_Wide_Wide_String'Access; 1686 1687 -- Otherwise, allocate new shared string and fill it 1688 1689 else 1690 DR := Allocate (SR.Last); 1691 1692 for J in 1 .. SR.Last loop 1693 DR.Data (J) := Value (Mapping, SR.Data (J)); 1694 end loop; 1695 1696 DR.Last := SR.Last; 1697 end if; 1698 1699 return (AF.Controlled with Reference => DR); 1700 end Translate; 1701 1702 procedure Translate 1703 (Source : in out Unbounded_Wide_Wide_String; 1704 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 1705 is 1706 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1707 DR : Shared_Wide_Wide_String_Access; 1708 1709 begin 1710 -- Nothing to translate 1711 1712 if SR.Last = 0 then 1713 null; 1714 1715 -- Try to reuse shared string 1716 1717 elsif Can_Be_Reused (SR, SR.Last) then 1718 for J in 1 .. SR.Last loop 1719 SR.Data (J) := Value (Mapping, SR.Data (J)); 1720 end loop; 1721 1722 -- Otherwise, allocate new shared string 1723 1724 else 1725 DR := Allocate (SR.Last); 1726 1727 for J in 1 .. SR.Last loop 1728 DR.Data (J) := Value (Mapping, SR.Data (J)); 1729 end loop; 1730 1731 DR.Last := SR.Last; 1732 Source.Reference := DR; 1733 Unreference (SR); 1734 end if; 1735 end Translate; 1736 1737 function Translate 1738 (Source : Unbounded_Wide_Wide_String; 1739 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 1740 return Unbounded_Wide_Wide_String 1741 is 1742 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1743 DR : Shared_Wide_Wide_String_Access; 1744 1745 begin 1746 -- Nothing to translate, reuse empty shared string 1747 1748 if SR.Last = 0 then 1749 Reference (Empty_Shared_Wide_Wide_String'Access); 1750 DR := Empty_Shared_Wide_Wide_String'Access; 1751 1752 -- Otherwise, allocate new shared string and fill it 1753 1754 else 1755 DR := Allocate (SR.Last); 1756 1757 for J in 1 .. SR.Last loop 1758 DR.Data (J) := Mapping.all (SR.Data (J)); 1759 end loop; 1760 1761 DR.Last := SR.Last; 1762 end if; 1763 1764 return (AF.Controlled with Reference => DR); 1765 1766 exception 1767 when others => 1768 Unreference (DR); 1769 1770 raise; 1771 end Translate; 1772 1773 procedure Translate 1774 (Source : in out Unbounded_Wide_Wide_String; 1775 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 1776 is 1777 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1778 DR : Shared_Wide_Wide_String_Access; 1779 1780 begin 1781 -- Nothing to translate 1782 1783 if SR.Last = 0 then 1784 null; 1785 1786 -- Try to reuse shared string 1787 1788 elsif Can_Be_Reused (SR, SR.Last) then 1789 for J in 1 .. SR.Last loop 1790 SR.Data (J) := Mapping.all (SR.Data (J)); 1791 end loop; 1792 1793 -- Otherwise allocate new shared string and fill it 1794 1795 else 1796 DR := Allocate (SR.Last); 1797 1798 for J in 1 .. SR.Last loop 1799 DR.Data (J) := Mapping.all (SR.Data (J)); 1800 end loop; 1801 1802 DR.Last := SR.Last; 1803 Source.Reference := DR; 1804 Unreference (SR); 1805 end if; 1806 1807 exception 1808 when others => 1809 if DR /= null then 1810 Unreference (DR); 1811 end if; 1812 1813 raise; 1814 end Translate; 1815 1816 ---------- 1817 -- Trim -- 1818 ---------- 1819 1820 function Trim 1821 (Source : Unbounded_Wide_Wide_String; 1822 Side : Trim_End) return Unbounded_Wide_Wide_String 1823 is 1824 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1825 DL : Natural; 1826 DR : Shared_Wide_Wide_String_Access; 1827 Low : Natural; 1828 High : Natural; 1829 1830 begin 1831 Low := Index_Non_Blank (Source, Forward); 1832 1833 -- All blanks, reuse empty shared string 1834 1835 if Low = 0 then 1836 Reference (Empty_Shared_Wide_Wide_String'Access); 1837 DR := Empty_Shared_Wide_Wide_String'Access; 1838 1839 else 1840 case Side is 1841 when Left => 1842 High := SR.Last; 1843 DL := SR.Last - Low + 1; 1844 1845 when Right => 1846 Low := 1; 1847 High := Index_Non_Blank (Source, Backward); 1848 DL := High; 1849 1850 when Both => 1851 High := Index_Non_Blank (Source, Backward); 1852 DL := High - Low + 1; 1853 end case; 1854 1855 -- Length of the result is the same as length of the source string, 1856 -- reuse source shared string. 1857 1858 if DL = SR.Last then 1859 Reference (SR); 1860 DR := SR; 1861 1862 -- Otherwise, allocate new shared string 1863 1864 else 1865 DR := Allocate (DL); 1866 DR.Data (1 .. DL) := SR.Data (Low .. High); 1867 DR.Last := DL; 1868 end if; 1869 end if; 1870 1871 return (AF.Controlled with Reference => DR); 1872 end Trim; 1873 1874 procedure Trim 1875 (Source : in out Unbounded_Wide_Wide_String; 1876 Side : Trim_End) 1877 is 1878 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1879 DL : Natural; 1880 DR : Shared_Wide_Wide_String_Access; 1881 Low : Natural; 1882 High : Natural; 1883 1884 begin 1885 Low := Index_Non_Blank (Source, Forward); 1886 1887 -- All blanks, reuse empty shared string 1888 1889 if Low = 0 then 1890 Reference (Empty_Shared_Wide_Wide_String'Access); 1891 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 1892 Unreference (SR); 1893 1894 else 1895 case Side is 1896 when Left => 1897 High := SR.Last; 1898 DL := SR.Last - Low + 1; 1899 1900 when Right => 1901 Low := 1; 1902 High := Index_Non_Blank (Source, Backward); 1903 DL := High; 1904 1905 when Both => 1906 High := Index_Non_Blank (Source, Backward); 1907 DL := High - Low + 1; 1908 end case; 1909 1910 -- Length of the result is the same as length of the source string, 1911 -- nothing to do. 1912 1913 if DL = SR.Last then 1914 null; 1915 1916 -- Try to reuse existent shared string 1917 1918 elsif Can_Be_Reused (SR, DL) then 1919 SR.Data (1 .. DL) := SR.Data (Low .. High); 1920 SR.Last := DL; 1921 1922 -- Otherwise, allocate new shared string 1923 1924 else 1925 DR := Allocate (DL); 1926 DR.Data (1 .. DL) := SR.Data (Low .. High); 1927 DR.Last := DL; 1928 Source.Reference := DR; 1929 Unreference (SR); 1930 end if; 1931 end if; 1932 end Trim; 1933 1934 function Trim 1935 (Source : Unbounded_Wide_Wide_String; 1936 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 1937 Right : Wide_Wide_Maps.Wide_Wide_Character_Set) 1938 return Unbounded_Wide_Wide_String 1939 is 1940 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1941 DL : Natural; 1942 DR : Shared_Wide_Wide_String_Access; 1943 Low : Natural; 1944 High : Natural; 1945 1946 begin 1947 Low := Index (Source, Left, Outside, Forward); 1948 1949 -- Source includes only characters from Left set, reuse empty shared 1950 -- string. 1951 1952 if Low = 0 then 1953 Reference (Empty_Shared_Wide_Wide_String'Access); 1954 DR := Empty_Shared_Wide_Wide_String'Access; 1955 1956 else 1957 High := Index (Source, Right, Outside, Backward); 1958 DL := Integer'Max (0, High - Low + 1); 1959 1960 -- Source includes only characters from Right set or result string 1961 -- is empty, reuse empty shared string. 1962 1963 if High = 0 or else DL = 0 then 1964 Reference (Empty_Shared_Wide_Wide_String'Access); 1965 DR := Empty_Shared_Wide_Wide_String'Access; 1966 1967 -- Otherwise, allocate new shared string and fill it 1968 1969 else 1970 DR := Allocate (DL); 1971 DR.Data (1 .. DL) := SR.Data (Low .. High); 1972 DR.Last := DL; 1973 end if; 1974 end if; 1975 1976 return (AF.Controlled with Reference => DR); 1977 end Trim; 1978 1979 procedure Trim 1980 (Source : in out Unbounded_Wide_Wide_String; 1981 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 1982 Right : Wide_Wide_Maps.Wide_Wide_Character_Set) 1983 is 1984 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 1985 DL : Natural; 1986 DR : Shared_Wide_Wide_String_Access; 1987 Low : Natural; 1988 High : Natural; 1989 1990 begin 1991 Low := Index (Source, Left, Outside, Forward); 1992 1993 -- Source includes only characters from Left set, reuse empty shared 1994 -- string. 1995 1996 if Low = 0 then 1997 Reference (Empty_Shared_Wide_Wide_String'Access); 1998 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 1999 Unreference (SR); 2000 2001 else 2002 High := Index (Source, Right, Outside, Backward); 2003 DL := Integer'Max (0, High - Low + 1); 2004 2005 -- Source includes only characters from Right set or result string 2006 -- is empty, reuse empty shared string. 2007 2008 if High = 0 or else DL = 0 then 2009 Reference (Empty_Shared_Wide_Wide_String'Access); 2010 Source.Reference := Empty_Shared_Wide_Wide_String'Access; 2011 Unreference (SR); 2012 2013 -- Try to reuse existent shared string 2014 2015 elsif Can_Be_Reused (SR, DL) then 2016 SR.Data (1 .. DL) := SR.Data (Low .. High); 2017 SR.Last := DL; 2018 2019 -- Otherwise, allocate new shared string and fill it 2020 2021 else 2022 DR := Allocate (DL); 2023 DR.Data (1 .. DL) := SR.Data (Low .. High); 2024 DR.Last := DL; 2025 Source.Reference := DR; 2026 Unreference (SR); 2027 end if; 2028 end if; 2029 end Trim; 2030 2031 --------------------- 2032 -- Unbounded_Slice -- 2033 --------------------- 2034 2035 function Unbounded_Slice 2036 (Source : Unbounded_Wide_Wide_String; 2037 Low : Positive; 2038 High : Natural) return Unbounded_Wide_Wide_String 2039 is 2040 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 2041 DL : Natural; 2042 DR : Shared_Wide_Wide_String_Access; 2043 2044 begin 2045 -- Check bounds 2046 2047 if Low > SR.Last + 1 or else High > SR.Last then 2048 raise Index_Error; 2049 2050 -- Result is empty slice, reuse empty shared string 2051 2052 elsif Low > High then 2053 Reference (Empty_Shared_Wide_Wide_String'Access); 2054 DR := Empty_Shared_Wide_Wide_String'Access; 2055 2056 -- Otherwise, allocate new shared string and fill it 2057 2058 else 2059 DL := High - Low + 1; 2060 DR := Allocate (DL); 2061 DR.Data (1 .. DL) := SR.Data (Low .. High); 2062 DR.Last := DL; 2063 end if; 2064 2065 return (AF.Controlled with Reference => DR); 2066 end Unbounded_Slice; 2067 2068 procedure Unbounded_Slice 2069 (Source : Unbounded_Wide_Wide_String; 2070 Target : out Unbounded_Wide_Wide_String; 2071 Low : Positive; 2072 High : Natural) 2073 is 2074 SR : constant Shared_Wide_Wide_String_Access := Source.Reference; 2075 TR : constant Shared_Wide_Wide_String_Access := Target.Reference; 2076 DL : Natural; 2077 DR : Shared_Wide_Wide_String_Access; 2078 2079 begin 2080 -- Check bounds 2081 2082 if Low > SR.Last + 1 or else High > SR.Last then 2083 raise Index_Error; 2084 2085 -- Result is empty slice, reuse empty shared string 2086 2087 elsif Low > High then 2088 Reference (Empty_Shared_Wide_Wide_String'Access); 2089 Target.Reference := Empty_Shared_Wide_Wide_String'Access; 2090 Unreference (TR); 2091 2092 else 2093 DL := High - Low + 1; 2094 2095 -- Try to reuse existent shared string 2096 2097 if Can_Be_Reused (TR, DL) then 2098 TR.Data (1 .. DL) := SR.Data (Low .. High); 2099 TR.Last := DL; 2100 2101 -- Otherwise, allocate new shared string and fill it 2102 2103 else 2104 DR := Allocate (DL); 2105 DR.Data (1 .. DL) := SR.Data (Low .. High); 2106 DR.Last := DL; 2107 Target.Reference := DR; 2108 Unreference (TR); 2109 end if; 2110 end if; 2111 end Unbounded_Slice; 2112 2113 ----------------- 2114 -- Unreference -- 2115 ----------------- 2116 2117 procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is 2118 2119 procedure Free is 2120 new Ada.Unchecked_Deallocation 2121 (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access); 2122 2123 Aux : Shared_Wide_Wide_String_Access := Item; 2124 2125 begin 2126 if System.Atomic_Counters.Decrement (Aux.Counter) then 2127 2128 -- Reference counter of Empty_Shared_Wide_Wide_String must never 2129 -- reach zero. 2130 2131 pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access); 2132 2133 Free (Aux); 2134 end if; 2135 end Unreference; 2136 2137end Ada.Strings.Wide_Wide_Unbounded; 2138