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 _ S U P E R B O U N D E D -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2003-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_Wide_Maps; use Ada.Strings.Wide_Wide_Maps; 33with Ada.Strings.Wide_Wide_Search; 34 35package body Ada.Strings.Wide_Wide_Superbounded is 36 37 ------------ 38 -- Concat -- 39 ------------ 40 41 function Concat 42 (Left : Super_String; 43 Right : Super_String) return Super_String 44 is 45 begin 46 return Result : Super_String (Left.Max_Length) do 47 declare 48 Llen : constant Natural := Left.Current_Length; 49 Rlen : constant Natural := Right.Current_Length; 50 Nlen : constant Natural := Llen + Rlen; 51 52 begin 53 if Nlen > Left.Max_Length then 54 raise Ada.Strings.Length_Error; 55 else 56 Result.Current_Length := Nlen; 57 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 58 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); 59 end if; 60 end; 61 end return; 62 end Concat; 63 64 function Concat 65 (Left : Super_String; 66 Right : Wide_Wide_String) return Super_String 67 is 68 begin 69 return Result : Super_String (Left.Max_Length) do 70 declare 71 Llen : constant Natural := Left.Current_Length; 72 Nlen : constant Natural := Llen + Right'Length; 73 74 begin 75 if Nlen > Left.Max_Length then 76 raise Ada.Strings.Length_Error; 77 else 78 Result.Current_Length := Nlen; 79 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 80 Result.Data (Llen + 1 .. Nlen) := Right; 81 end if; 82 end; 83 end return; 84 end Concat; 85 86 function Concat 87 (Left : Wide_Wide_String; 88 Right : Super_String) return Super_String 89 is 90 begin 91 return Result : Super_String (Right.Max_Length) do 92 declare 93 Llen : constant Natural := Left'Length; 94 Rlen : constant Natural := Right.Current_Length; 95 Nlen : constant Natural := Llen + Rlen; 96 97 begin 98 if Nlen > Right.Max_Length then 99 raise Ada.Strings.Length_Error; 100 else 101 Result.Current_Length := Nlen; 102 Result.Data (1 .. Llen) := Left; 103 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); 104 end if; 105 end; 106 end return; 107 end Concat; 108 109 function Concat 110 (Left : Super_String; 111 Right : Wide_Wide_Character) return Super_String 112 is 113 begin 114 return Result : Super_String (Left.Max_Length) do 115 declare 116 Llen : constant Natural := Left.Current_Length; 117 118 begin 119 if Llen = Left.Max_Length then 120 raise Ada.Strings.Length_Error; 121 else 122 Result.Current_Length := Llen + 1; 123 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 124 Result.Data (Result.Current_Length) := Right; 125 end if; 126 end; 127 end return; 128 end Concat; 129 130 function Concat 131 (Left : Wide_Wide_Character; 132 Right : Super_String) return Super_String 133 is 134 begin 135 return Result : Super_String (Right.Max_Length) do 136 declare 137 Rlen : constant Natural := Right.Current_Length; 138 139 begin 140 if Rlen = Right.Max_Length then 141 raise Ada.Strings.Length_Error; 142 else 143 Result.Current_Length := Rlen + 1; 144 Result.Data (1) := Left; 145 Result.Data (2 .. Result.Current_Length) := 146 Right.Data (1 .. Rlen); 147 end if; 148 end; 149 end return; 150 end Concat; 151 152 ----------- 153 -- Equal -- 154 ----------- 155 156 function "=" 157 (Left : Super_String; 158 Right : Super_String) return Boolean 159 is 160 begin 161 return Left.Current_Length = Right.Current_Length 162 and then Left.Data (1 .. Left.Current_Length) = 163 Right.Data (1 .. Right.Current_Length); 164 end "="; 165 166 function Equal 167 (Left : Super_String; 168 Right : Wide_Wide_String) return Boolean 169 is 170 begin 171 return Left.Current_Length = Right'Length 172 and then Left.Data (1 .. Left.Current_Length) = Right; 173 end Equal; 174 175 function Equal 176 (Left : Wide_Wide_String; 177 Right : Super_String) return Boolean 178 is 179 begin 180 return Left'Length = Right.Current_Length 181 and then Left = Right.Data (1 .. Right.Current_Length); 182 end Equal; 183 184 ------------- 185 -- Greater -- 186 ------------- 187 188 function Greater 189 (Left : Super_String; 190 Right : Super_String) return Boolean 191 is 192 begin 193 return Left.Data (1 .. Left.Current_Length) > 194 Right.Data (1 .. Right.Current_Length); 195 end Greater; 196 197 function Greater 198 (Left : Super_String; 199 Right : Wide_Wide_String) return Boolean 200 is 201 begin 202 return Left.Data (1 .. Left.Current_Length) > Right; 203 end Greater; 204 205 function Greater 206 (Left : Wide_Wide_String; 207 Right : Super_String) return Boolean 208 is 209 begin 210 return Left > Right.Data (1 .. Right.Current_Length); 211 end Greater; 212 213 ---------------------- 214 -- Greater_Or_Equal -- 215 ---------------------- 216 217 function Greater_Or_Equal 218 (Left : Super_String; 219 Right : Super_String) return Boolean 220 is 221 begin 222 return Left.Data (1 .. Left.Current_Length) >= 223 Right.Data (1 .. Right.Current_Length); 224 end Greater_Or_Equal; 225 226 function Greater_Or_Equal 227 (Left : Super_String; 228 Right : Wide_Wide_String) return Boolean 229 is 230 begin 231 return Left.Data (1 .. Left.Current_Length) >= Right; 232 end Greater_Or_Equal; 233 234 function Greater_Or_Equal 235 (Left : Wide_Wide_String; 236 Right : Super_String) return Boolean 237 is 238 begin 239 return Left >= Right.Data (1 .. Right.Current_Length); 240 end Greater_Or_Equal; 241 242 ---------- 243 -- Less -- 244 ---------- 245 246 function Less 247 (Left : Super_String; 248 Right : Super_String) return Boolean 249 is 250 begin 251 return Left.Data (1 .. Left.Current_Length) < 252 Right.Data (1 .. Right.Current_Length); 253 end Less; 254 255 function Less 256 (Left : Super_String; 257 Right : Wide_Wide_String) return Boolean 258 is 259 begin 260 return Left.Data (1 .. Left.Current_Length) < Right; 261 end Less; 262 263 function Less 264 (Left : Wide_Wide_String; 265 Right : Super_String) return Boolean 266 is 267 begin 268 return Left < Right.Data (1 .. Right.Current_Length); 269 end Less; 270 271 ------------------- 272 -- Less_Or_Equal -- 273 ------------------- 274 275 function Less_Or_Equal 276 (Left : Super_String; 277 Right : Super_String) return Boolean 278 is 279 begin 280 return Left.Data (1 .. Left.Current_Length) <= 281 Right.Data (1 .. Right.Current_Length); 282 end Less_Or_Equal; 283 284 function Less_Or_Equal 285 (Left : Super_String; 286 Right : Wide_Wide_String) return Boolean 287 is 288 begin 289 return Left.Data (1 .. Left.Current_Length) <= Right; 290 end Less_Or_Equal; 291 292 function Less_Or_Equal 293 (Left : Wide_Wide_String; 294 Right : Super_String) return Boolean 295 is 296 begin 297 return Left <= Right.Data (1 .. Right.Current_Length); 298 end Less_Or_Equal; 299 300 ---------------------- 301 -- Set_Super_String -- 302 ---------------------- 303 304 procedure Set_Super_String 305 (Target : out Super_String; 306 Source : Wide_Wide_String; 307 Drop : Truncation := Error) 308 is 309 Slen : constant Natural := Source'Length; 310 Max_Length : constant Positive := Target.Max_Length; 311 312 begin 313 if Slen <= Max_Length then 314 Target.Current_Length := Slen; 315 Target.Data (1 .. Slen) := Source; 316 317 else 318 case Drop is 319 when Strings.Right => 320 Target.Current_Length := Max_Length; 321 Target.Data (1 .. Max_Length) := 322 Source (Source'First .. Source'First - 1 + Max_Length); 323 324 when Strings.Left => 325 Target.Current_Length := Max_Length; 326 Target.Data (1 .. Max_Length) := 327 Source (Source'Last - (Max_Length - 1) .. Source'Last); 328 329 when Strings.Error => 330 raise Ada.Strings.Length_Error; 331 end case; 332 end if; 333 end Set_Super_String; 334 335 ------------------ 336 -- Super_Append -- 337 ------------------ 338 339 -- Case of Super_String and Super_String 340 341 function Super_Append 342 (Left : Super_String; 343 Right : Super_String; 344 Drop : Strings.Truncation := Strings.Error) return Super_String 345 is 346 Max_Length : constant Positive := Left.Max_Length; 347 Result : Super_String (Max_Length); 348 Llen : constant Natural := Left.Current_Length; 349 Rlen : constant Natural := Right.Current_Length; 350 Nlen : constant Natural := Llen + Rlen; 351 352 begin 353 if Nlen <= Max_Length then 354 Result.Current_Length := Nlen; 355 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 356 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); 357 358 else 359 Result.Current_Length := Max_Length; 360 361 case Drop is 362 when Strings.Right => 363 if Llen >= Max_Length then -- only case is Llen = Max_Length 364 Result.Data := Left.Data; 365 366 else 367 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 368 Result.Data (Llen + 1 .. Max_Length) := 369 Right.Data (1 .. Max_Length - Llen); 370 end if; 371 372 when Strings.Left => 373 if Rlen >= Max_Length then -- only case is Rlen = Max_Length 374 Result.Data := Right.Data; 375 376 else 377 Result.Data (1 .. Max_Length - Rlen) := 378 Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 379 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 380 Right.Data (1 .. Rlen); 381 end if; 382 383 when Strings.Error => 384 raise Ada.Strings.Length_Error; 385 end case; 386 end if; 387 388 return Result; 389 end Super_Append; 390 391 procedure Super_Append 392 (Source : in out Super_String; 393 New_Item : Super_String; 394 Drop : Truncation := Error) 395 is 396 Max_Length : constant Positive := Source.Max_Length; 397 Llen : constant Natural := Source.Current_Length; 398 Rlen : constant Natural := New_Item.Current_Length; 399 Nlen : constant Natural := Llen + Rlen; 400 401 begin 402 if Nlen <= Max_Length then 403 Source.Current_Length := Nlen; 404 Source.Data (Llen + 1 .. Nlen) := New_Item.Data (1 .. Rlen); 405 406 else 407 Source.Current_Length := Max_Length; 408 409 case Drop is 410 when Strings.Right => 411 if Llen < Max_Length then 412 Source.Data (Llen + 1 .. Max_Length) := 413 New_Item.Data (1 .. Max_Length - Llen); 414 end if; 415 416 when Strings.Left => 417 if Rlen >= Max_Length then -- only case is Rlen = Max_Length 418 Source.Data := New_Item.Data; 419 420 else 421 Source.Data (1 .. Max_Length - Rlen) := 422 Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 423 Source.Data (Max_Length - Rlen + 1 .. Max_Length) := 424 New_Item.Data (1 .. Rlen); 425 end if; 426 427 when Strings.Error => 428 raise Ada.Strings.Length_Error; 429 end case; 430 end if; 431 432 end Super_Append; 433 434 -- Case of Super_String and Wide_Wide_String 435 436 function Super_Append 437 (Left : Super_String; 438 Right : Wide_Wide_String; 439 Drop : Strings.Truncation := Strings.Error) return Super_String 440 is 441 Max_Length : constant Positive := Left.Max_Length; 442 Result : Super_String (Max_Length); 443 Llen : constant Natural := Left.Current_Length; 444 Rlen : constant Natural := Right'Length; 445 Nlen : constant Natural := Llen + Rlen; 446 447 begin 448 if Nlen <= Max_Length then 449 Result.Current_Length := Nlen; 450 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 451 Result.Data (Llen + 1 .. Nlen) := Right; 452 453 else 454 Result.Current_Length := Max_Length; 455 456 case Drop is 457 when Strings.Right => 458 if Llen >= Max_Length then -- only case is Llen = Max_Length 459 Result.Data := Left.Data; 460 461 else 462 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 463 Result.Data (Llen + 1 .. Max_Length) := 464 Right (Right'First .. Right'First - 1 + 465 Max_Length - Llen); 466 467 end if; 468 469 when Strings.Left => 470 if Rlen >= Max_Length then 471 Result.Data (1 .. Max_Length) := 472 Right (Right'Last - (Max_Length - 1) .. Right'Last); 473 474 else 475 Result.Data (1 .. Max_Length - Rlen) := 476 Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 477 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 478 Right; 479 end if; 480 481 when Strings.Error => 482 raise Ada.Strings.Length_Error; 483 end case; 484 end if; 485 486 return Result; 487 end Super_Append; 488 489 procedure Super_Append 490 (Source : in out Super_String; 491 New_Item : Wide_Wide_String; 492 Drop : Truncation := Error) 493 is 494 Max_Length : constant Positive := Source.Max_Length; 495 Llen : constant Natural := Source.Current_Length; 496 Rlen : constant Natural := New_Item'Length; 497 Nlen : constant Natural := Llen + Rlen; 498 499 begin 500 if Nlen <= Max_Length then 501 Source.Current_Length := Nlen; 502 Source.Data (Llen + 1 .. Nlen) := New_Item; 503 504 else 505 Source.Current_Length := Max_Length; 506 507 case Drop is 508 when Strings.Right => 509 if Llen < Max_Length then 510 Source.Data (Llen + 1 .. Max_Length) := 511 New_Item (New_Item'First .. 512 New_Item'First - 1 + Max_Length - Llen); 513 end if; 514 515 when Strings.Left => 516 if Rlen >= Max_Length then 517 Source.Data (1 .. Max_Length) := 518 New_Item (New_Item'Last - (Max_Length - 1) .. 519 New_Item'Last); 520 521 else 522 Source.Data (1 .. Max_Length - Rlen) := 523 Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen); 524 Source.Data (Max_Length - Rlen + 1 .. Max_Length) := 525 New_Item; 526 end if; 527 528 when Strings.Error => 529 raise Ada.Strings.Length_Error; 530 end case; 531 end if; 532 end Super_Append; 533 534 -- Case of Wide_Wide_String and Super_String 535 536 function Super_Append 537 (Left : Wide_Wide_String; 538 Right : Super_String; 539 Drop : Strings.Truncation := Strings.Error) return Super_String 540 is 541 Max_Length : constant Positive := Right.Max_Length; 542 Result : Super_String (Max_Length); 543 Llen : constant Natural := Left'Length; 544 Rlen : constant Natural := Right.Current_Length; 545 Nlen : constant Natural := Llen + Rlen; 546 547 begin 548 if Nlen <= Max_Length then 549 Result.Current_Length := Nlen; 550 Result.Data (1 .. Llen) := Left; 551 Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen); 552 553 else 554 Result.Current_Length := Max_Length; 555 556 case Drop is 557 when Strings.Right => 558 if Llen >= Max_Length then 559 Result.Data (1 .. Max_Length) := 560 Left (Left'First .. Left'First + (Max_Length - 1)); 561 562 else 563 Result.Data (1 .. Llen) := Left; 564 Result.Data (Llen + 1 .. Max_Length) := 565 Right.Data (1 .. Max_Length - Llen); 566 end if; 567 568 when Strings.Left => 569 if Rlen >= Max_Length then 570 Result.Data (1 .. Max_Length) := 571 Right.Data (Rlen - (Max_Length - 1) .. Rlen); 572 573 else 574 Result.Data (1 .. Max_Length - Rlen) := 575 Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last); 576 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 577 Right.Data (1 .. Rlen); 578 end if; 579 580 when Strings.Error => 581 raise Ada.Strings.Length_Error; 582 end case; 583 end if; 584 585 return Result; 586 end Super_Append; 587 588 -- Case of Super_String and Wide_Wide_Character 589 590 function Super_Append 591 (Left : Super_String; 592 Right : Wide_Wide_Character; 593 Drop : Strings.Truncation := Strings.Error) return Super_String 594 is 595 Max_Length : constant Positive := Left.Max_Length; 596 Result : Super_String (Max_Length); 597 Llen : constant Natural := Left.Current_Length; 598 599 begin 600 if Llen < Max_Length then 601 Result.Current_Length := Llen + 1; 602 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 603 Result.Data (Llen + 1) := Right; 604 return Result; 605 606 else 607 case Drop is 608 when Strings.Right => 609 return Left; 610 611 when Strings.Left => 612 Result.Current_Length := Max_Length; 613 Result.Data (1 .. Max_Length - 1) := 614 Left.Data (2 .. Max_Length); 615 Result.Data (Max_Length) := Right; 616 return Result; 617 618 when Strings.Error => 619 raise Ada.Strings.Length_Error; 620 end case; 621 end if; 622 end Super_Append; 623 624 procedure Super_Append 625 (Source : in out Super_String; 626 New_Item : Wide_Wide_Character; 627 Drop : Truncation := Error) 628 is 629 Max_Length : constant Positive := Source.Max_Length; 630 Llen : constant Natural := Source.Current_Length; 631 632 begin 633 if Llen < Max_Length then 634 Source.Current_Length := Llen + 1; 635 Source.Data (Llen + 1) := New_Item; 636 637 else 638 Source.Current_Length := Max_Length; 639 640 case Drop is 641 when Strings.Right => 642 null; 643 644 when Strings.Left => 645 Source.Data (1 .. Max_Length - 1) := 646 Source.Data (2 .. Max_Length); 647 Source.Data (Max_Length) := New_Item; 648 649 when Strings.Error => 650 raise Ada.Strings.Length_Error; 651 end case; 652 end if; 653 654 end Super_Append; 655 656 -- Case of Wide_Wide_Character and Super_String 657 658 function Super_Append 659 (Left : Wide_Wide_Character; 660 Right : Super_String; 661 Drop : Strings.Truncation := Strings.Error) return Super_String 662 is 663 Max_Length : constant Positive := Right.Max_Length; 664 Result : Super_String (Max_Length); 665 Rlen : constant Natural := Right.Current_Length; 666 667 begin 668 if Rlen < Max_Length then 669 Result.Current_Length := Rlen + 1; 670 Result.Data (1) := Left; 671 Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen); 672 return Result; 673 674 else 675 case Drop is 676 when Strings.Right => 677 Result.Current_Length := Max_Length; 678 Result.Data (1) := Left; 679 Result.Data (2 .. Max_Length) := 680 Right.Data (1 .. Max_Length - 1); 681 return Result; 682 683 when Strings.Left => 684 return Right; 685 686 when Strings.Error => 687 raise Ada.Strings.Length_Error; 688 end case; 689 end if; 690 end Super_Append; 691 692 ----------------- 693 -- Super_Count -- 694 ----------------- 695 696 function Super_Count 697 (Source : Super_String; 698 Pattern : Wide_Wide_String; 699 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 700 Wide_Wide_Maps.Identity) return Natural 701 is 702 begin 703 return 704 Wide_Wide_Search.Count 705 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); 706 end Super_Count; 707 708 function Super_Count 709 (Source : Super_String; 710 Pattern : Wide_Wide_String; 711 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 712 return Natural 713 is 714 begin 715 return 716 Wide_Wide_Search.Count 717 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); 718 end Super_Count; 719 720 function Super_Count 721 (Source : Super_String; 722 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural 723 is 724 begin 725 return Wide_Wide_Search.Count 726 (Source.Data (1 .. Source.Current_Length), Set); 727 end Super_Count; 728 729 ------------------ 730 -- Super_Delete -- 731 ------------------ 732 733 function Super_Delete 734 (Source : Super_String; 735 From : Positive; 736 Through : Natural) return Super_String 737 is 738 Result : Super_String (Source.Max_Length); 739 Slen : constant Natural := Source.Current_Length; 740 Num_Delete : constant Integer := Through - From + 1; 741 742 begin 743 if Num_Delete <= 0 then 744 return Source; 745 746 elsif From > Slen + 1 then 747 raise Ada.Strings.Index_Error; 748 749 elsif Through >= Slen then 750 Result.Current_Length := From - 1; 751 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); 752 return Result; 753 754 else 755 Result.Current_Length := Slen - Num_Delete; 756 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); 757 Result.Data (From .. Result.Current_Length) := 758 Source.Data (Through + 1 .. Slen); 759 return Result; 760 end if; 761 end Super_Delete; 762 763 procedure Super_Delete 764 (Source : in out Super_String; 765 From : Positive; 766 Through : Natural) 767 is 768 Slen : constant Natural := Source.Current_Length; 769 Num_Delete : constant Integer := Through - From + 1; 770 771 begin 772 if Num_Delete <= 0 then 773 return; 774 775 elsif From > Slen + 1 then 776 raise Ada.Strings.Index_Error; 777 778 elsif Through >= Slen then 779 Source.Current_Length := From - 1; 780 781 else 782 Source.Current_Length := Slen - Num_Delete; 783 Source.Data (From .. Source.Current_Length) := 784 Source.Data (Through + 1 .. Slen); 785 end if; 786 end Super_Delete; 787 788 ------------------- 789 -- Super_Element -- 790 ------------------- 791 792 function Super_Element 793 (Source : Super_String; 794 Index : Positive) return Wide_Wide_Character 795 is 796 begin 797 if Index <= Source.Current_Length then 798 return Source.Data (Index); 799 else 800 raise Strings.Index_Error; 801 end if; 802 end Super_Element; 803 804 ---------------------- 805 -- Super_Find_Token -- 806 ---------------------- 807 808 procedure Super_Find_Token 809 (Source : Super_String; 810 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 811 From : Positive; 812 Test : Strings.Membership; 813 First : out Positive; 814 Last : out Natural) 815 is 816 begin 817 Wide_Wide_Search.Find_Token 818 (Source.Data (From .. Source.Current_Length), Set, Test, First, Last); 819 end Super_Find_Token; 820 821 procedure Super_Find_Token 822 (Source : Super_String; 823 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 824 Test : Strings.Membership; 825 First : out Positive; 826 Last : out Natural) 827 is 828 begin 829 Wide_Wide_Search.Find_Token 830 (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last); 831 end Super_Find_Token; 832 833 ---------------- 834 -- Super_Head -- 835 ---------------- 836 837 function Super_Head 838 (Source : Super_String; 839 Count : Natural; 840 Pad : Wide_Wide_Character := Wide_Wide_Space; 841 Drop : Strings.Truncation := Strings.Error) return Super_String 842 is 843 Max_Length : constant Positive := Source.Max_Length; 844 Result : Super_String (Max_Length); 845 Slen : constant Natural := Source.Current_Length; 846 Npad : constant Integer := Count - Slen; 847 848 begin 849 if Npad <= 0 then 850 Result.Current_Length := Count; 851 Result.Data (1 .. Count) := Source.Data (1 .. Count); 852 853 elsif Count <= Max_Length then 854 Result.Current_Length := Count; 855 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 856 Result.Data (Slen + 1 .. Count) := (others => Pad); 857 858 else 859 Result.Current_Length := Max_Length; 860 861 case Drop is 862 when Strings.Right => 863 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 864 Result.Data (Slen + 1 .. Max_Length) := (others => Pad); 865 866 when Strings.Left => 867 if Npad >= Max_Length then 868 Result.Data := (others => Pad); 869 870 else 871 Result.Data (1 .. Max_Length - Npad) := 872 Source.Data (Count - Max_Length + 1 .. Slen); 873 Result.Data (Max_Length - Npad + 1 .. Max_Length) := 874 (others => Pad); 875 end if; 876 877 when Strings.Error => 878 raise Ada.Strings.Length_Error; 879 end case; 880 end if; 881 882 return Result; 883 end Super_Head; 884 885 procedure Super_Head 886 (Source : in out Super_String; 887 Count : Natural; 888 Pad : Wide_Wide_Character := Wide_Wide_Space; 889 Drop : Truncation := Error) 890 is 891 Max_Length : constant Positive := Source.Max_Length; 892 Slen : constant Natural := Source.Current_Length; 893 Npad : constant Integer := Count - Slen; 894 Temp : Wide_Wide_String (1 .. Max_Length); 895 896 begin 897 if Npad <= 0 then 898 Source.Current_Length := Count; 899 900 elsif Count <= Max_Length then 901 Source.Current_Length := Count; 902 Source.Data (Slen + 1 .. Count) := (others => Pad); 903 904 else 905 Source.Current_Length := Max_Length; 906 907 case Drop is 908 when Strings.Right => 909 Source.Data (Slen + 1 .. Max_Length) := (others => Pad); 910 911 when Strings.Left => 912 if Npad > Max_Length then 913 Source.Data := (others => Pad); 914 915 else 916 Temp := Source.Data; 917 Source.Data (1 .. Max_Length - Npad) := 918 Temp (Count - Max_Length + 1 .. Slen); 919 920 for J in Max_Length - Npad + 1 .. Max_Length loop 921 Source.Data (J) := Pad; 922 end loop; 923 end if; 924 925 when Strings.Error => 926 raise Ada.Strings.Length_Error; 927 end case; 928 end if; 929 end Super_Head; 930 931 ----------------- 932 -- Super_Index -- 933 ----------------- 934 935 function Super_Index 936 (Source : Super_String; 937 Pattern : Wide_Wide_String; 938 Going : Strings.Direction := Strings.Forward; 939 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 940 Wide_Wide_Maps.Identity) return Natural 941 is 942 begin 943 return Wide_Wide_Search.Index 944 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); 945 end Super_Index; 946 947 function Super_Index 948 (Source : Super_String; 949 Pattern : Wide_Wide_String; 950 Going : Direction := Forward; 951 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 952 return Natural 953 is 954 begin 955 return Wide_Wide_Search.Index 956 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); 957 end Super_Index; 958 959 function Super_Index 960 (Source : Super_String; 961 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 962 Test : Strings.Membership := Strings.Inside; 963 Going : Strings.Direction := Strings.Forward) return Natural 964 is 965 begin 966 return Wide_Wide_Search.Index 967 (Source.Data (1 .. Source.Current_Length), Set, Test, Going); 968 end Super_Index; 969 970 function Super_Index 971 (Source : Super_String; 972 Pattern : Wide_Wide_String; 973 From : Positive; 974 Going : Direction := Forward; 975 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping := 976 Wide_Wide_Maps.Identity) return Natural 977 is 978 begin 979 return Wide_Wide_Search.Index 980 (Source.Data (1 .. Source.Current_Length), 981 Pattern, From, Going, Mapping); 982 end Super_Index; 983 984 function Super_Index 985 (Source : Super_String; 986 Pattern : Wide_Wide_String; 987 From : Positive; 988 Going : Direction := Forward; 989 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 990 return Natural 991 is 992 begin 993 return Wide_Wide_Search.Index 994 (Source.Data (1 .. Source.Current_Length), 995 Pattern, From, Going, Mapping); 996 end Super_Index; 997 998 function Super_Index 999 (Source : Super_String; 1000 Set : Wide_Wide_Maps.Wide_Wide_Character_Set; 1001 From : Positive; 1002 Test : Membership := Inside; 1003 Going : Direction := Forward) return Natural 1004 is 1005 begin 1006 return Wide_Wide_Search.Index 1007 (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going); 1008 end Super_Index; 1009 1010 --------------------------- 1011 -- Super_Index_Non_Blank -- 1012 --------------------------- 1013 1014 function Super_Index_Non_Blank 1015 (Source : Super_String; 1016 Going : Strings.Direction := Strings.Forward) return Natural 1017 is 1018 begin 1019 return 1020 Wide_Wide_Search.Index_Non_Blank 1021 (Source.Data (1 .. Source.Current_Length), Going); 1022 end Super_Index_Non_Blank; 1023 1024 function Super_Index_Non_Blank 1025 (Source : Super_String; 1026 From : Positive; 1027 Going : Direction := Forward) return Natural 1028 is 1029 begin 1030 return 1031 Wide_Wide_Search.Index_Non_Blank 1032 (Source.Data (1 .. Source.Current_Length), From, Going); 1033 end Super_Index_Non_Blank; 1034 1035 ------------------ 1036 -- Super_Insert -- 1037 ------------------ 1038 1039 function Super_Insert 1040 (Source : Super_String; 1041 Before : Positive; 1042 New_Item : Wide_Wide_String; 1043 Drop : Strings.Truncation := Strings.Error) return Super_String 1044 is 1045 Max_Length : constant Positive := Source.Max_Length; 1046 Result : Super_String (Max_Length); 1047 Slen : constant Natural := Source.Current_Length; 1048 Nlen : constant Natural := New_Item'Length; 1049 Tlen : constant Natural := Slen + Nlen; 1050 Blen : constant Natural := Before - 1; 1051 Alen : constant Integer := Slen - Blen; 1052 Droplen : constant Integer := Tlen - Max_Length; 1053 1054 -- Tlen is the length of the total string before possible truncation. 1055 -- Blen, Alen are the lengths of the before and after pieces of the 1056 -- source string. 1057 1058 begin 1059 if Alen < 0 then 1060 raise Ada.Strings.Index_Error; 1061 1062 elsif Droplen <= 0 then 1063 Result.Current_Length := Tlen; 1064 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1065 Result.Data (Before .. Before + Nlen - 1) := New_Item; 1066 Result.Data (Before + Nlen .. Tlen) := 1067 Source.Data (Before .. Slen); 1068 1069 else 1070 Result.Current_Length := Max_Length; 1071 1072 case Drop is 1073 when Strings.Right => 1074 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1075 1076 if Droplen > Alen then 1077 Result.Data (Before .. Max_Length) := 1078 New_Item (New_Item'First 1079 .. New_Item'First + Max_Length - Before); 1080 else 1081 Result.Data (Before .. Before + Nlen - 1) := New_Item; 1082 Result.Data (Before + Nlen .. Max_Length) := 1083 Source.Data (Before .. Slen - Droplen); 1084 end if; 1085 1086 when Strings.Left => 1087 Result.Data (Max_Length - (Alen - 1) .. Max_Length) := 1088 Source.Data (Before .. Slen); 1089 1090 if Droplen >= Blen then 1091 Result.Data (1 .. Max_Length - Alen) := 1092 New_Item (New_Item'Last - (Max_Length - Alen) + 1 1093 .. New_Item'Last); 1094 else 1095 Result.Data 1096 (Blen - Droplen + 1 .. Max_Length - Alen) := 1097 New_Item; 1098 Result.Data (1 .. Blen - Droplen) := 1099 Source.Data (Droplen + 1 .. Blen); 1100 end if; 1101 1102 when Strings.Error => 1103 raise Ada.Strings.Length_Error; 1104 end case; 1105 end if; 1106 1107 return Result; 1108 end Super_Insert; 1109 1110 procedure Super_Insert 1111 (Source : in out Super_String; 1112 Before : Positive; 1113 New_Item : Wide_Wide_String; 1114 Drop : Strings.Truncation := Strings.Error) 1115 is 1116 begin 1117 -- We do a double copy here because this is one of the situations 1118 -- in which we move data to the right, and at least at the moment, 1119 -- GNAT is not handling such cases correctly ??? 1120 1121 Source := Super_Insert (Source, Before, New_Item, Drop); 1122 end Super_Insert; 1123 1124 ------------------ 1125 -- Super_Length -- 1126 ------------------ 1127 1128 function Super_Length (Source : Super_String) return Natural is 1129 begin 1130 return Source.Current_Length; 1131 end Super_Length; 1132 1133 --------------------- 1134 -- Super_Overwrite -- 1135 --------------------- 1136 1137 function Super_Overwrite 1138 (Source : Super_String; 1139 Position : Positive; 1140 New_Item : Wide_Wide_String; 1141 Drop : Strings.Truncation := Strings.Error) return Super_String 1142 is 1143 Max_Length : constant Positive := Source.Max_Length; 1144 Result : Super_String (Max_Length); 1145 Endpos : constant Natural := Position + New_Item'Length - 1; 1146 Slen : constant Natural := Source.Current_Length; 1147 Droplen : Natural; 1148 1149 begin 1150 if Position > Slen + 1 then 1151 raise Ada.Strings.Index_Error; 1152 1153 elsif New_Item'Length = 0 then 1154 return Source; 1155 1156 elsif Endpos <= Slen then 1157 Result.Current_Length := Source.Current_Length; 1158 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 1159 Result.Data (Position .. Endpos) := New_Item; 1160 return Result; 1161 1162 elsif Endpos <= Max_Length then 1163 Result.Current_Length := Endpos; 1164 Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1); 1165 Result.Data (Position .. Endpos) := New_Item; 1166 return Result; 1167 1168 else 1169 Result.Current_Length := Max_Length; 1170 Droplen := Endpos - Max_Length; 1171 1172 case Drop is 1173 when Strings.Right => 1174 Result.Data (1 .. Position - 1) := 1175 Source.Data (1 .. Position - 1); 1176 1177 Result.Data (Position .. Max_Length) := 1178 New_Item (New_Item'First .. New_Item'Last - Droplen); 1179 return Result; 1180 1181 when Strings.Left => 1182 if New_Item'Length >= Max_Length then 1183 Result.Data (1 .. Max_Length) := 1184 New_Item (New_Item'Last - Max_Length + 1 .. 1185 New_Item'Last); 1186 return Result; 1187 1188 else 1189 Result.Data (1 .. Max_Length - New_Item'Length) := 1190 Source.Data (Droplen + 1 .. Position - 1); 1191 Result.Data 1192 (Max_Length - New_Item'Length + 1 .. Max_Length) := 1193 New_Item; 1194 return Result; 1195 end if; 1196 1197 when Strings.Error => 1198 raise Ada.Strings.Length_Error; 1199 end case; 1200 end if; 1201 end Super_Overwrite; 1202 1203 procedure Super_Overwrite 1204 (Source : in out Super_String; 1205 Position : Positive; 1206 New_Item : Wide_Wide_String; 1207 Drop : Strings.Truncation := Strings.Error) 1208 is 1209 Max_Length : constant Positive := Source.Max_Length; 1210 Endpos : constant Positive := Position + New_Item'Length - 1; 1211 Slen : constant Natural := Source.Current_Length; 1212 Droplen : Natural; 1213 1214 begin 1215 if Position > Slen + 1 then 1216 raise Ada.Strings.Index_Error; 1217 1218 elsif Endpos <= Slen then 1219 Source.Data (Position .. Endpos) := New_Item; 1220 1221 elsif Endpos <= Max_Length then 1222 Source.Data (Position .. Endpos) := New_Item; 1223 Source.Current_Length := Endpos; 1224 1225 else 1226 Source.Current_Length := Max_Length; 1227 Droplen := Endpos - Max_Length; 1228 1229 case Drop is 1230 when Strings.Right => 1231 Source.Data (Position .. Max_Length) := 1232 New_Item (New_Item'First .. New_Item'Last - Droplen); 1233 1234 when Strings.Left => 1235 if New_Item'Length > Max_Length then 1236 Source.Data (1 .. Max_Length) := 1237 New_Item (New_Item'Last - Max_Length + 1 .. 1238 New_Item'Last); 1239 1240 else 1241 Source.Data (1 .. Max_Length - New_Item'Length) := 1242 Source.Data (Droplen + 1 .. Position - 1); 1243 1244 Source.Data 1245 (Max_Length - New_Item'Length + 1 .. Max_Length) := 1246 New_Item; 1247 end if; 1248 1249 when Strings.Error => 1250 raise Ada.Strings.Length_Error; 1251 end case; 1252 end if; 1253 end Super_Overwrite; 1254 1255 --------------------------- 1256 -- Super_Replace_Element -- 1257 --------------------------- 1258 1259 procedure Super_Replace_Element 1260 (Source : in out Super_String; 1261 Index : Positive; 1262 By : Wide_Wide_Character) 1263 is 1264 begin 1265 if Index <= Source.Current_Length then 1266 Source.Data (Index) := By; 1267 else 1268 raise Ada.Strings.Index_Error; 1269 end if; 1270 end Super_Replace_Element; 1271 1272 ------------------------- 1273 -- Super_Replace_Slice -- 1274 ------------------------- 1275 1276 function Super_Replace_Slice 1277 (Source : Super_String; 1278 Low : Positive; 1279 High : Natural; 1280 By : Wide_Wide_String; 1281 Drop : Strings.Truncation := Strings.Error) return Super_String 1282 is 1283 Max_Length : constant Positive := Source.Max_Length; 1284 Slen : constant Natural := Source.Current_Length; 1285 1286 begin 1287 if Low > Slen + 1 then 1288 raise Strings.Index_Error; 1289 1290 elsif High < Low then 1291 return Super_Insert (Source, Low, By, Drop); 1292 1293 else 1294 declare 1295 Blen : constant Natural := Natural'Max (0, Low - 1); 1296 Alen : constant Natural := Natural'Max (0, Slen - High); 1297 Tlen : constant Natural := Blen + By'Length + Alen; 1298 Droplen : constant Integer := Tlen - Max_Length; 1299 Result : Super_String (Max_Length); 1300 1301 -- Tlen is the total length of the result string before any 1302 -- truncation. Blen and Alen are the lengths of the pieces 1303 -- of the original string that end up in the result string 1304 -- before and after the replaced slice. 1305 1306 begin 1307 if Droplen <= 0 then 1308 Result.Current_Length := Tlen; 1309 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1310 Result.Data (Low .. Low + By'Length - 1) := By; 1311 Result.Data (Low + By'Length .. Tlen) := 1312 Source.Data (High + 1 .. Slen); 1313 1314 else 1315 Result.Current_Length := Max_Length; 1316 1317 case Drop is 1318 when Strings.Right => 1319 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1320 1321 if Droplen > Alen then 1322 Result.Data (Low .. Max_Length) := 1323 By (By'First .. By'First + Max_Length - Low); 1324 else 1325 Result.Data (Low .. Low + By'Length - 1) := By; 1326 Result.Data (Low + By'Length .. Max_Length) := 1327 Source.Data (High + 1 .. Slen - Droplen); 1328 end if; 1329 1330 when Strings.Left => 1331 Result.Data (Max_Length - (Alen - 1) .. Max_Length) := 1332 Source.Data (High + 1 .. Slen); 1333 1334 if Droplen >= Blen then 1335 Result.Data (1 .. Max_Length - Alen) := 1336 By (By'Last - (Max_Length - Alen) + 1 .. By'Last); 1337 else 1338 Result.Data 1339 (Blen - Droplen + 1 .. Max_Length - Alen) := By; 1340 Result.Data (1 .. Blen - Droplen) := 1341 Source.Data (Droplen + 1 .. Blen); 1342 end if; 1343 1344 when Strings.Error => 1345 raise Ada.Strings.Length_Error; 1346 end case; 1347 end if; 1348 1349 return Result; 1350 end; 1351 end if; 1352 end Super_Replace_Slice; 1353 1354 procedure Super_Replace_Slice 1355 (Source : in out Super_String; 1356 Low : Positive; 1357 High : Natural; 1358 By : Wide_Wide_String; 1359 Drop : Strings.Truncation := Strings.Error) 1360 is 1361 begin 1362 -- We do a double copy here because this is one of the situations 1363 -- in which we move data to the right, and at least at the moment, 1364 -- GNAT is not handling such cases correctly ??? 1365 1366 Source := Super_Replace_Slice (Source, Low, High, By, Drop); 1367 end Super_Replace_Slice; 1368 1369 --------------------- 1370 -- Super_Replicate -- 1371 --------------------- 1372 1373 function Super_Replicate 1374 (Count : Natural; 1375 Item : Wide_Wide_Character; 1376 Drop : Truncation := Error; 1377 Max_Length : Positive) return Super_String 1378 is 1379 Result : Super_String (Max_Length); 1380 1381 begin 1382 if Count <= Max_Length then 1383 Result.Current_Length := Count; 1384 1385 elsif Drop = Strings.Error then 1386 raise Ada.Strings.Length_Error; 1387 1388 else 1389 Result.Current_Length := Max_Length; 1390 end if; 1391 1392 Result.Data (1 .. Result.Current_Length) := (others => Item); 1393 return Result; 1394 end Super_Replicate; 1395 1396 function Super_Replicate 1397 (Count : Natural; 1398 Item : Wide_Wide_String; 1399 Drop : Truncation := Error; 1400 Max_Length : Positive) return Super_String 1401 is 1402 Length : constant Integer := Count * Item'Length; 1403 Result : Super_String (Max_Length); 1404 Indx : Positive; 1405 1406 begin 1407 if Length <= Max_Length then 1408 Result.Current_Length := Length; 1409 1410 if Length > 0 then 1411 Indx := 1; 1412 1413 for J in 1 .. Count loop 1414 Result.Data (Indx .. Indx + Item'Length - 1) := Item; 1415 Indx := Indx + Item'Length; 1416 end loop; 1417 end if; 1418 1419 else 1420 Result.Current_Length := Max_Length; 1421 1422 case Drop is 1423 when Strings.Right => 1424 Indx := 1; 1425 1426 while Indx + Item'Length <= Max_Length + 1 loop 1427 Result.Data (Indx .. Indx + Item'Length - 1) := Item; 1428 Indx := Indx + Item'Length; 1429 end loop; 1430 1431 Result.Data (Indx .. Max_Length) := 1432 Item (Item'First .. Item'First + Max_Length - Indx); 1433 1434 when Strings.Left => 1435 Indx := Max_Length; 1436 1437 while Indx - Item'Length >= 1 loop 1438 Result.Data (Indx - (Item'Length - 1) .. Indx) := Item; 1439 Indx := Indx - Item'Length; 1440 end loop; 1441 1442 Result.Data (1 .. Indx) := 1443 Item (Item'Last - Indx + 1 .. Item'Last); 1444 1445 when Strings.Error => 1446 raise Ada.Strings.Length_Error; 1447 end case; 1448 end if; 1449 1450 return Result; 1451 end Super_Replicate; 1452 1453 function Super_Replicate 1454 (Count : Natural; 1455 Item : Super_String; 1456 Drop : Strings.Truncation := Strings.Error) return Super_String 1457 is 1458 begin 1459 return 1460 Super_Replicate 1461 (Count, 1462 Item.Data (1 .. Item.Current_Length), 1463 Drop, 1464 Item.Max_Length); 1465 end Super_Replicate; 1466 1467 ----------------- 1468 -- Super_Slice -- 1469 ----------------- 1470 1471 function Super_Slice 1472 (Source : Super_String; 1473 Low : Positive; 1474 High : Natural) return Wide_Wide_String 1475 is 1476 begin 1477 -- Note: test of High > Length is in accordance with AI95-00128 1478 1479 return R : Wide_Wide_String (Low .. High) do 1480 if Low > Source.Current_Length + 1 1481 or else High > Source.Current_Length 1482 then 1483 raise Index_Error; 1484 end if; 1485 1486 R := Source.Data (Low .. High); 1487 end return; 1488 end Super_Slice; 1489 1490 function Super_Slice 1491 (Source : Super_String; 1492 Low : Positive; 1493 High : Natural) return Super_String 1494 is 1495 begin 1496 return Result : Super_String (Source.Max_Length) do 1497 if Low > Source.Current_Length + 1 1498 or else High > Source.Current_Length 1499 then 1500 raise Index_Error; 1501 else 1502 Result.Current_Length := High - Low + 1; 1503 Result.Data (1 .. Result.Current_Length) := 1504 Source.Data (Low .. High); 1505 end if; 1506 end return; 1507 end Super_Slice; 1508 1509 procedure Super_Slice 1510 (Source : Super_String; 1511 Target : out Super_String; 1512 Low : Positive; 1513 High : Natural) 1514 is 1515 begin 1516 if Low > Source.Current_Length + 1 1517 or else High > Source.Current_Length 1518 then 1519 raise Index_Error; 1520 else 1521 Target.Current_Length := High - Low + 1; 1522 Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); 1523 end if; 1524 end Super_Slice; 1525 1526 ---------------- 1527 -- Super_Tail -- 1528 ---------------- 1529 1530 function Super_Tail 1531 (Source : Super_String; 1532 Count : Natural; 1533 Pad : Wide_Wide_Character := Wide_Wide_Space; 1534 Drop : Strings.Truncation := Strings.Error) return Super_String 1535 is 1536 Max_Length : constant Positive := Source.Max_Length; 1537 Result : Super_String (Max_Length); 1538 Slen : constant Natural := Source.Current_Length; 1539 Npad : constant Integer := Count - Slen; 1540 1541 begin 1542 if Npad <= 0 then 1543 Result.Current_Length := Count; 1544 Result.Data (1 .. Count) := 1545 Source.Data (Slen - (Count - 1) .. Slen); 1546 1547 elsif Count <= Max_Length then 1548 Result.Current_Length := Count; 1549 Result.Data (1 .. Npad) := (others => Pad); 1550 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen); 1551 1552 else 1553 Result.Current_Length := Max_Length; 1554 1555 case Drop is 1556 when Strings.Right => 1557 if Npad >= Max_Length then 1558 Result.Data := (others => Pad); 1559 1560 else 1561 Result.Data (1 .. Npad) := (others => Pad); 1562 Result.Data (Npad + 1 .. Max_Length) := 1563 Source.Data (1 .. Max_Length - Npad); 1564 end if; 1565 1566 when Strings.Left => 1567 Result.Data (1 .. Max_Length - Slen) := (others => Pad); 1568 Result.Data (Max_Length - Slen + 1 .. Max_Length) := 1569 Source.Data (1 .. Slen); 1570 1571 when Strings.Error => 1572 raise Ada.Strings.Length_Error; 1573 end case; 1574 end if; 1575 1576 return Result; 1577 end Super_Tail; 1578 1579 procedure Super_Tail 1580 (Source : in out Super_String; 1581 Count : Natural; 1582 Pad : Wide_Wide_Character := Wide_Wide_Space; 1583 Drop : Truncation := Error) 1584 is 1585 Max_Length : constant Positive := Source.Max_Length; 1586 Slen : constant Natural := Source.Current_Length; 1587 Npad : constant Integer := Count - Slen; 1588 1589 Temp : constant Wide_Wide_String (1 .. Max_Length) := Source.Data; 1590 1591 begin 1592 if Npad <= 0 then 1593 Source.Current_Length := Count; 1594 Source.Data (1 .. Count) := 1595 Temp (Slen - (Count - 1) .. Slen); 1596 1597 elsif Count <= Max_Length then 1598 Source.Current_Length := Count; 1599 Source.Data (1 .. Npad) := (others => Pad); 1600 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen); 1601 1602 else 1603 Source.Current_Length := Max_Length; 1604 1605 case Drop is 1606 when Strings.Right => 1607 if Npad >= Max_Length then 1608 Source.Data := (others => Pad); 1609 1610 else 1611 Source.Data (1 .. Npad) := (others => Pad); 1612 Source.Data (Npad + 1 .. Max_Length) := 1613 Temp (1 .. Max_Length - Npad); 1614 end if; 1615 1616 when Strings.Left => 1617 for J in 1 .. Max_Length - Slen loop 1618 Source.Data (J) := Pad; 1619 end loop; 1620 1621 Source.Data (Max_Length - Slen + 1 .. Max_Length) := 1622 Temp (1 .. Slen); 1623 1624 when Strings.Error => 1625 raise Ada.Strings.Length_Error; 1626 end case; 1627 end if; 1628 end Super_Tail; 1629 1630 --------------------- 1631 -- Super_To_String -- 1632 --------------------- 1633 1634 function Super_To_String 1635 (Source : Super_String) return Wide_Wide_String 1636 is 1637 begin 1638 return R : Wide_Wide_String (1 .. Source.Current_Length) do 1639 R := Source.Data (1 .. Source.Current_Length); 1640 end return; 1641 end Super_To_String; 1642 1643 --------------------- 1644 -- Super_Translate -- 1645 --------------------- 1646 1647 function Super_Translate 1648 (Source : Super_String; 1649 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 1650 return Super_String 1651 is 1652 Result : Super_String (Source.Max_Length); 1653 1654 begin 1655 Result.Current_Length := Source.Current_Length; 1656 1657 for J in 1 .. Source.Current_Length loop 1658 Result.Data (J) := Value (Mapping, Source.Data (J)); 1659 end loop; 1660 1661 return Result; 1662 end Super_Translate; 1663 1664 procedure Super_Translate 1665 (Source : in out Super_String; 1666 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping) 1667 is 1668 begin 1669 for J in 1 .. Source.Current_Length loop 1670 Source.Data (J) := Value (Mapping, Source.Data (J)); 1671 end loop; 1672 end Super_Translate; 1673 1674 function Super_Translate 1675 (Source : Super_String; 1676 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 1677 return Super_String 1678 is 1679 Result : Super_String (Source.Max_Length); 1680 1681 begin 1682 Result.Current_Length := Source.Current_Length; 1683 1684 for J in 1 .. Source.Current_Length loop 1685 Result.Data (J) := Mapping.all (Source.Data (J)); 1686 end loop; 1687 1688 return Result; 1689 end Super_Translate; 1690 1691 procedure Super_Translate 1692 (Source : in out Super_String; 1693 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function) 1694 is 1695 begin 1696 for J in 1 .. Source.Current_Length loop 1697 Source.Data (J) := Mapping.all (Source.Data (J)); 1698 end loop; 1699 end Super_Translate; 1700 1701 ---------------- 1702 -- Super_Trim -- 1703 ---------------- 1704 1705 function Super_Trim 1706 (Source : Super_String; 1707 Side : Trim_End) return Super_String 1708 is 1709 Result : Super_String (Source.Max_Length); 1710 Last : Natural := Source.Current_Length; 1711 First : Positive := 1; 1712 1713 begin 1714 if Side = Left or else Side = Both then 1715 while First <= Last and then Source.Data (First) = ' ' loop 1716 First := First + 1; 1717 end loop; 1718 end if; 1719 1720 if Side = Right or else Side = Both then 1721 while Last >= First and then Source.Data (Last) = ' ' loop 1722 Last := Last - 1; 1723 end loop; 1724 end if; 1725 1726 Result.Current_Length := Last - First + 1; 1727 Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last); 1728 return Result; 1729 end Super_Trim; 1730 1731 procedure Super_Trim 1732 (Source : in out Super_String; 1733 Side : Trim_End) 1734 is 1735 Max_Length : constant Positive := Source.Max_Length; 1736 Last : Natural := Source.Current_Length; 1737 First : Positive := 1; 1738 Temp : Wide_Wide_String (1 .. Max_Length); 1739 1740 begin 1741 Temp (1 .. Last) := Source.Data (1 .. Last); 1742 1743 if Side = Left or else Side = Both then 1744 while First <= Last and then Temp (First) = ' ' loop 1745 First := First + 1; 1746 end loop; 1747 end if; 1748 1749 if Side = Right or else Side = Both then 1750 while Last >= First and then Temp (Last) = ' ' loop 1751 Last := Last - 1; 1752 end loop; 1753 end if; 1754 1755 Source.Data := (others => Wide_Wide_NUL); 1756 Source.Current_Length := Last - First + 1; 1757 Source.Data (1 .. Source.Current_Length) := Temp (First .. Last); 1758 end Super_Trim; 1759 1760 function Super_Trim 1761 (Source : Super_String; 1762 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 1763 Right : Wide_Wide_Maps.Wide_Wide_Character_Set) return Super_String 1764 is 1765 Result : Super_String (Source.Max_Length); 1766 1767 begin 1768 for First in 1 .. Source.Current_Length loop 1769 if not Is_In (Source.Data (First), Left) then 1770 for Last in reverse First .. Source.Current_Length loop 1771 if not Is_In (Source.Data (Last), Right) then 1772 Result.Current_Length := Last - First + 1; 1773 Result.Data (1 .. Result.Current_Length) := 1774 Source.Data (First .. Last); 1775 return Result; 1776 end if; 1777 end loop; 1778 end if; 1779 end loop; 1780 1781 Result.Current_Length := 0; 1782 return Result; 1783 end Super_Trim; 1784 1785 procedure Super_Trim 1786 (Source : in out Super_String; 1787 Left : Wide_Wide_Maps.Wide_Wide_Character_Set; 1788 Right : Wide_Wide_Maps.Wide_Wide_Character_Set) 1789 is 1790 begin 1791 for First in 1 .. Source.Current_Length loop 1792 if not Is_In (Source.Data (First), Left) then 1793 for Last in reverse First .. Source.Current_Length loop 1794 if not Is_In (Source.Data (Last), Right) then 1795 if First = 1 then 1796 Source.Current_Length := Last; 1797 return; 1798 else 1799 Source.Current_Length := Last - First + 1; 1800 Source.Data (1 .. Source.Current_Length) := 1801 Source.Data (First .. Last); 1802 1803 for J in Source.Current_Length + 1 .. 1804 Source.Max_Length 1805 loop 1806 Source.Data (J) := Wide_Wide_NUL; 1807 end loop; 1808 1809 return; 1810 end if; 1811 end if; 1812 end loop; 1813 1814 Source.Current_Length := 0; 1815 return; 1816 end if; 1817 end loop; 1818 1819 Source.Current_Length := 0; 1820 end Super_Trim; 1821 1822 ----------- 1823 -- Times -- 1824 ----------- 1825 1826 function Times 1827 (Left : Natural; 1828 Right : Wide_Wide_Character; 1829 Max_Length : Positive) return Super_String 1830 is 1831 Result : Super_String (Max_Length); 1832 1833 begin 1834 if Left > Max_Length then 1835 raise Ada.Strings.Length_Error; 1836 1837 else 1838 Result.Current_Length := Left; 1839 1840 for J in 1 .. Left loop 1841 Result.Data (J) := Right; 1842 end loop; 1843 end if; 1844 1845 return Result; 1846 end Times; 1847 1848 function Times 1849 (Left : Natural; 1850 Right : Wide_Wide_String; 1851 Max_Length : Positive) return Super_String 1852 is 1853 Result : Super_String (Max_Length); 1854 Pos : Positive := 1; 1855 Rlen : constant Natural := Right'Length; 1856 Nlen : constant Natural := Left * Rlen; 1857 1858 begin 1859 if Nlen > Max_Length then 1860 raise Ada.Strings.Index_Error; 1861 1862 else 1863 Result.Current_Length := Nlen; 1864 1865 if Nlen > 0 then 1866 for J in 1 .. Left loop 1867 Result.Data (Pos .. Pos + Rlen - 1) := Right; 1868 Pos := Pos + Rlen; 1869 end loop; 1870 end if; 1871 end if; 1872 1873 return Result; 1874 end Times; 1875 1876 function Times 1877 (Left : Natural; 1878 Right : Super_String) return Super_String 1879 is 1880 Result : Super_String (Right.Max_Length); 1881 Pos : Positive := 1; 1882 Rlen : constant Natural := Right.Current_Length; 1883 Nlen : constant Natural := Left * Rlen; 1884 1885 begin 1886 if Nlen > Right.Max_Length then 1887 raise Ada.Strings.Length_Error; 1888 1889 else 1890 Result.Current_Length := Nlen; 1891 1892 if Nlen > 0 then 1893 for J in 1 .. Left loop 1894 Result.Data (Pos .. Pos + Rlen - 1) := 1895 Right.Data (1 .. Rlen); 1896 Pos := Pos + Rlen; 1897 end loop; 1898 end if; 1899 end if; 1900 1901 return Result; 1902 end Times; 1903 1904 --------------------- 1905 -- To_Super_String -- 1906 --------------------- 1907 1908 function To_Super_String 1909 (Source : Wide_Wide_String; 1910 Max_Length : Natural; 1911 Drop : Truncation := Error) return Super_String 1912 is 1913 Result : Super_String (Max_Length); 1914 Slen : constant Natural := Source'Length; 1915 1916 begin 1917 if Slen <= Max_Length then 1918 Result.Current_Length := Slen; 1919 Result.Data (1 .. Slen) := Source; 1920 1921 else 1922 case Drop is 1923 when Strings.Right => 1924 Result.Current_Length := Max_Length; 1925 Result.Data (1 .. Max_Length) := 1926 Source (Source'First .. Source'First - 1 + Max_Length); 1927 1928 when Strings.Left => 1929 Result.Current_Length := Max_Length; 1930 Result.Data (1 .. Max_Length) := 1931 Source (Source'Last - (Max_Length - 1) .. Source'Last); 1932 1933 when Strings.Error => 1934 raise Ada.Strings.Length_Error; 1935 end case; 1936 end if; 1937 1938 return Result; 1939 end To_Super_String; 1940 1941end Ada.Strings.Wide_Wide_Superbounded; 1942