1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . S T R I N G S . 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-2012, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps; 33with Ada.Strings.Wide_Search; 34 35package body Ada.Strings.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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_String 435 436 function Super_Append 437 (Left : Super_String; 438 Right : 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_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 533 end Super_Append; 534 535 -- Case of Wide_String and Super_String 536 537 function Super_Append 538 (Left : Wide_String; 539 Right : Super_String; 540 Drop : Strings.Truncation := Strings.Error) return Super_String 541 is 542 Max_Length : constant Positive := Right.Max_Length; 543 Result : Super_String (Max_Length); 544 Llen : constant Natural := Left'Length; 545 Rlen : constant Natural := Right.Current_Length; 546 Nlen : constant Natural := Llen + Rlen; 547 548 begin 549 if Nlen <= Max_Length then 550 Result.Current_Length := Nlen; 551 Result.Data (1 .. Llen) := Left; 552 Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen); 553 554 else 555 Result.Current_Length := Max_Length; 556 557 case Drop is 558 when Strings.Right => 559 if Llen >= Max_Length then 560 Result.Data (1 .. Max_Length) := 561 Left (Left'First .. Left'First + (Max_Length - 1)); 562 563 else 564 Result.Data (1 .. Llen) := Left; 565 Result.Data (Llen + 1 .. Max_Length) := 566 Right.Data (1 .. Max_Length - Llen); 567 end if; 568 569 when Strings.Left => 570 if Rlen >= Max_Length then 571 Result.Data (1 .. Max_Length) := 572 Right.Data (Rlen - (Max_Length - 1) .. Rlen); 573 574 else 575 Result.Data (1 .. Max_Length - Rlen) := 576 Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last); 577 Result.Data (Max_Length - Rlen + 1 .. Max_Length) := 578 Right.Data (1 .. Rlen); 579 end if; 580 581 when Strings.Error => 582 raise Ada.Strings.Length_Error; 583 end case; 584 end if; 585 586 return Result; 587 end Super_Append; 588 589 -- Case of Super_String and Wide_Character 590 591 function Super_Append 592 (Left : Super_String; 593 Right : Wide_Character; 594 Drop : Strings.Truncation := Strings.Error) return Super_String 595 is 596 Max_Length : constant Positive := Left.Max_Length; 597 Result : Super_String (Max_Length); 598 Llen : constant Natural := Left.Current_Length; 599 600 begin 601 if Llen < Max_Length then 602 Result.Current_Length := Llen + 1; 603 Result.Data (1 .. Llen) := Left.Data (1 .. Llen); 604 Result.Data (Llen + 1) := Right; 605 return Result; 606 607 else 608 case Drop is 609 when Strings.Right => 610 return Left; 611 612 when Strings.Left => 613 Result.Current_Length := Max_Length; 614 Result.Data (1 .. Max_Length - 1) := 615 Left.Data (2 .. Max_Length); 616 Result.Data (Max_Length) := Right; 617 return Result; 618 619 when Strings.Error => 620 raise Ada.Strings.Length_Error; 621 end case; 622 end if; 623 end Super_Append; 624 625 procedure Super_Append 626 (Source : in out Super_String; 627 New_Item : Wide_Character; 628 Drop : Truncation := Error) 629 is 630 Max_Length : constant Positive := Source.Max_Length; 631 Llen : constant Natural := Source.Current_Length; 632 633 begin 634 if Llen < Max_Length then 635 Source.Current_Length := Llen + 1; 636 Source.Data (Llen + 1) := New_Item; 637 638 else 639 Source.Current_Length := Max_Length; 640 641 case Drop is 642 when Strings.Right => 643 null; 644 645 when Strings.Left => 646 Source.Data (1 .. Max_Length - 1) := 647 Source.Data (2 .. Max_Length); 648 Source.Data (Max_Length) := New_Item; 649 650 when Strings.Error => 651 raise Ada.Strings.Length_Error; 652 end case; 653 end if; 654 655 end Super_Append; 656 657 -- Case of Wide_Character and Super_String 658 659 function Super_Append 660 (Left : Wide_Character; 661 Right : Super_String; 662 Drop : Strings.Truncation := Strings.Error) return Super_String 663 is 664 Max_Length : constant Positive := Right.Max_Length; 665 Result : Super_String (Max_Length); 666 Rlen : constant Natural := Right.Current_Length; 667 668 begin 669 if Rlen < Max_Length then 670 Result.Current_Length := Rlen + 1; 671 Result.Data (1) := Left; 672 Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen); 673 return Result; 674 675 else 676 case Drop is 677 when Strings.Right => 678 Result.Current_Length := Max_Length; 679 Result.Data (1) := Left; 680 Result.Data (2 .. Max_Length) := 681 Right.Data (1 .. Max_Length - 1); 682 return Result; 683 684 when Strings.Left => 685 return Right; 686 687 when Strings.Error => 688 raise Ada.Strings.Length_Error; 689 end case; 690 end if; 691 end Super_Append; 692 693 ----------------- 694 -- Super_Count -- 695 ----------------- 696 697 function Super_Count 698 (Source : Super_String; 699 Pattern : Wide_String; 700 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 701 return Natural 702 is 703 begin 704 return 705 Wide_Search.Count 706 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); 707 end Super_Count; 708 709 function Super_Count 710 (Source : Super_String; 711 Pattern : Wide_String; 712 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 713 is 714 begin 715 return 716 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_Maps.Wide_Character_Set) return Natural 723 is 724 begin 725 return Wide_Search.Count (Source.Data (1 .. Source.Current_Length), Set); 726 end Super_Count; 727 728 ------------------ 729 -- Super_Delete -- 730 ------------------ 731 732 function Super_Delete 733 (Source : Super_String; 734 From : Positive; 735 Through : Natural) return Super_String 736 is 737 Result : Super_String (Source.Max_Length); 738 Slen : constant Natural := Source.Current_Length; 739 Num_Delete : constant Integer := Through - From + 1; 740 741 begin 742 if Num_Delete <= 0 then 743 return Source; 744 745 elsif From > Slen + 1 then 746 raise Ada.Strings.Index_Error; 747 748 elsif Through >= Slen then 749 Result.Current_Length := From - 1; 750 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); 751 return Result; 752 753 else 754 Result.Current_Length := Slen - Num_Delete; 755 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); 756 Result.Data (From .. Result.Current_Length) := 757 Source.Data (Through + 1 .. Slen); 758 return Result; 759 end if; 760 end Super_Delete; 761 762 procedure Super_Delete 763 (Source : in out Super_String; 764 From : Positive; 765 Through : Natural) 766 is 767 Slen : constant Natural := Source.Current_Length; 768 Num_Delete : constant Integer := Through - From + 1; 769 770 begin 771 if Num_Delete <= 0 then 772 return; 773 774 elsif From > Slen + 1 then 775 raise Ada.Strings.Index_Error; 776 777 elsif Through >= Slen then 778 Source.Current_Length := From - 1; 779 780 else 781 Source.Current_Length := Slen - Num_Delete; 782 Source.Data (From .. Source.Current_Length) := 783 Source.Data (Through + 1 .. Slen); 784 end if; 785 end Super_Delete; 786 787 ------------------- 788 -- Super_Element -- 789 ------------------- 790 791 function Super_Element 792 (Source : Super_String; 793 Index : Positive) return Wide_Character 794 is 795 begin 796 if Index <= Source.Current_Length then 797 return Source.Data (Index); 798 else 799 raise Strings.Index_Error; 800 end if; 801 end Super_Element; 802 803 ---------------------- 804 -- Super_Find_Token -- 805 ---------------------- 806 807 procedure Super_Find_Token 808 (Source : Super_String; 809 Set : Wide_Maps.Wide_Character_Set; 810 From : Positive; 811 Test : Strings.Membership; 812 First : out Positive; 813 Last : out Natural) 814 is 815 begin 816 Wide_Search.Find_Token 817 (Source.Data (From .. Source.Current_Length), Set, Test, First, Last); 818 end Super_Find_Token; 819 820 procedure Super_Find_Token 821 (Source : Super_String; 822 Set : Wide_Maps.Wide_Character_Set; 823 Test : Strings.Membership; 824 First : out Positive; 825 Last : out Natural) 826 is 827 begin 828 Wide_Search.Find_Token 829 (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last); 830 end Super_Find_Token; 831 832 ---------------- 833 -- Super_Head -- 834 ---------------- 835 836 function Super_Head 837 (Source : Super_String; 838 Count : Natural; 839 Pad : Wide_Character := Wide_Space; 840 Drop : Strings.Truncation := Strings.Error) return Super_String 841 is 842 Max_Length : constant Positive := Source.Max_Length; 843 Result : Super_String (Max_Length); 844 Slen : constant Natural := Source.Current_Length; 845 Npad : constant Integer := Count - Slen; 846 847 begin 848 if Npad <= 0 then 849 Result.Current_Length := Count; 850 Result.Data (1 .. Count) := Source.Data (1 .. Count); 851 852 elsif Count <= Max_Length then 853 Result.Current_Length := Count; 854 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 855 Result.Data (Slen + 1 .. Count) := (others => Pad); 856 857 else 858 Result.Current_Length := Max_Length; 859 860 case Drop is 861 when Strings.Right => 862 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 863 Result.Data (Slen + 1 .. Max_Length) := (others => Pad); 864 865 when Strings.Left => 866 if Npad >= Max_Length then 867 Result.Data := (others => Pad); 868 869 else 870 Result.Data (1 .. Max_Length - Npad) := 871 Source.Data (Count - Max_Length + 1 .. Slen); 872 Result.Data (Max_Length - Npad + 1 .. Max_Length) := 873 (others => Pad); 874 end if; 875 876 when Strings.Error => 877 raise Ada.Strings.Length_Error; 878 end case; 879 end if; 880 881 return Result; 882 end Super_Head; 883 884 procedure Super_Head 885 (Source : in out Super_String; 886 Count : Natural; 887 Pad : Wide_Character := Wide_Space; 888 Drop : Truncation := Error) 889 is 890 Max_Length : constant Positive := Source.Max_Length; 891 Slen : constant Natural := Source.Current_Length; 892 Npad : constant Integer := Count - Slen; 893 Temp : Wide_String (1 .. Max_Length); 894 895 begin 896 if Npad <= 0 then 897 Source.Current_Length := Count; 898 899 elsif Count <= Max_Length then 900 Source.Current_Length := Count; 901 Source.Data (Slen + 1 .. Count) := (others => Pad); 902 903 else 904 Source.Current_Length := Max_Length; 905 906 case Drop is 907 when Strings.Right => 908 Source.Data (Slen + 1 .. Max_Length) := (others => Pad); 909 910 when Strings.Left => 911 if Npad > Max_Length then 912 Source.Data := (others => Pad); 913 914 else 915 Temp := Source.Data; 916 Source.Data (1 .. Max_Length - Npad) := 917 Temp (Count - Max_Length + 1 .. Slen); 918 919 for J in Max_Length - Npad + 1 .. Max_Length loop 920 Source.Data (J) := Pad; 921 end loop; 922 end if; 923 924 when Strings.Error => 925 raise Ada.Strings.Length_Error; 926 end case; 927 end if; 928 end Super_Head; 929 930 ----------------- 931 -- Super_Index -- 932 ----------------- 933 934 function Super_Index 935 (Source : Super_String; 936 Pattern : Wide_String; 937 Going : Strings.Direction := Strings.Forward; 938 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 939 return Natural 940 is 941 begin 942 return Wide_Search.Index 943 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); 944 end Super_Index; 945 946 function Super_Index 947 (Source : Super_String; 948 Pattern : Wide_String; 949 Going : Direction := Forward; 950 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 951 is 952 begin 953 return Wide_Search.Index 954 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); 955 end Super_Index; 956 957 function Super_Index 958 (Source : Super_String; 959 Set : Wide_Maps.Wide_Character_Set; 960 Test : Strings.Membership := Strings.Inside; 961 Going : Strings.Direction := Strings.Forward) return Natural 962 is 963 begin 964 return Wide_Search.Index 965 (Source.Data (1 .. Source.Current_Length), Set, Test, Going); 966 end Super_Index; 967 968 function Super_Index 969 (Source : Super_String; 970 Pattern : Wide_String; 971 From : Positive; 972 Going : Direction := Forward; 973 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity) 974 return Natural 975 is 976 begin 977 return Wide_Search.Index 978 (Source.Data (1 .. Source.Current_Length), 979 Pattern, From, Going, Mapping); 980 end Super_Index; 981 982 function Super_Index 983 (Source : Super_String; 984 Pattern : Wide_String; 985 From : Positive; 986 Going : Direction := Forward; 987 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural 988 is 989 begin 990 return Wide_Search.Index 991 (Source.Data (1 .. Source.Current_Length), 992 Pattern, From, Going, Mapping); 993 end Super_Index; 994 995 function Super_Index 996 (Source : Super_String; 997 Set : Wide_Maps.Wide_Character_Set; 998 From : Positive; 999 Test : Membership := Inside; 1000 Going : Direction := Forward) return Natural 1001 is 1002 begin 1003 return Wide_Search.Index 1004 (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going); 1005 end Super_Index; 1006 1007 --------------------------- 1008 -- Super_Index_Non_Blank -- 1009 --------------------------- 1010 1011 function Super_Index_Non_Blank 1012 (Source : Super_String; 1013 Going : Strings.Direction := Strings.Forward) return Natural 1014 is 1015 begin 1016 return 1017 Wide_Search.Index_Non_Blank 1018 (Source.Data (1 .. Source.Current_Length), Going); 1019 end Super_Index_Non_Blank; 1020 1021 function Super_Index_Non_Blank 1022 (Source : Super_String; 1023 From : Positive; 1024 Going : Direction := Forward) return Natural 1025 is 1026 begin 1027 return 1028 Wide_Search.Index_Non_Blank 1029 (Source.Data (1 .. Source.Current_Length), From, Going); 1030 end Super_Index_Non_Blank; 1031 1032 ------------------ 1033 -- Super_Insert -- 1034 ------------------ 1035 1036 function Super_Insert 1037 (Source : Super_String; 1038 Before : Positive; 1039 New_Item : Wide_String; 1040 Drop : Strings.Truncation := Strings.Error) return Super_String 1041 is 1042 Max_Length : constant Positive := Source.Max_Length; 1043 Result : Super_String (Max_Length); 1044 Slen : constant Natural := Source.Current_Length; 1045 Nlen : constant Natural := New_Item'Length; 1046 Tlen : constant Natural := Slen + Nlen; 1047 Blen : constant Natural := Before - 1; 1048 Alen : constant Integer := Slen - Blen; 1049 Droplen : constant Integer := Tlen - Max_Length; 1050 1051 -- Tlen is the length of the total string before possible truncation. 1052 -- Blen, Alen are the lengths of the before and after pieces of the 1053 -- source string. 1054 1055 begin 1056 if Alen < 0 then 1057 raise Ada.Strings.Index_Error; 1058 1059 elsif Droplen <= 0 then 1060 Result.Current_Length := Tlen; 1061 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1062 Result.Data (Before .. Before + Nlen - 1) := New_Item; 1063 Result.Data (Before + Nlen .. Tlen) := 1064 Source.Data (Before .. Slen); 1065 1066 else 1067 Result.Current_Length := Max_Length; 1068 1069 case Drop is 1070 when Strings.Right => 1071 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1072 1073 if Droplen > Alen then 1074 Result.Data (Before .. Max_Length) := 1075 New_Item (New_Item'First 1076 .. New_Item'First + Max_Length - Before); 1077 else 1078 Result.Data (Before .. Before + Nlen - 1) := New_Item; 1079 Result.Data (Before + Nlen .. Max_Length) := 1080 Source.Data (Before .. Slen - Droplen); 1081 end if; 1082 1083 when Strings.Left => 1084 Result.Data (Max_Length - (Alen - 1) .. Max_Length) := 1085 Source.Data (Before .. Slen); 1086 1087 if Droplen >= Blen then 1088 Result.Data (1 .. Max_Length - Alen) := 1089 New_Item (New_Item'Last - (Max_Length - Alen) + 1 1090 .. New_Item'Last); 1091 else 1092 Result.Data 1093 (Blen - Droplen + 1 .. Max_Length - Alen) := 1094 New_Item; 1095 Result.Data (1 .. Blen - Droplen) := 1096 Source.Data (Droplen + 1 .. Blen); 1097 end if; 1098 1099 when Strings.Error => 1100 raise Ada.Strings.Length_Error; 1101 end case; 1102 end if; 1103 1104 return Result; 1105 end Super_Insert; 1106 1107 procedure Super_Insert 1108 (Source : in out Super_String; 1109 Before : Positive; 1110 New_Item : Wide_String; 1111 Drop : Strings.Truncation := Strings.Error) 1112 is 1113 begin 1114 -- We do a double copy here because this is one of the situations 1115 -- in which we move data to the right, and at least at the moment, 1116 -- GNAT is not handling such cases correctly ??? 1117 1118 Source := Super_Insert (Source, Before, New_Item, Drop); 1119 end Super_Insert; 1120 1121 ------------------ 1122 -- Super_Length -- 1123 ------------------ 1124 1125 function Super_Length (Source : Super_String) return Natural is 1126 begin 1127 return Source.Current_Length; 1128 end Super_Length; 1129 1130 --------------------- 1131 -- Super_Overwrite -- 1132 --------------------- 1133 1134 function Super_Overwrite 1135 (Source : Super_String; 1136 Position : Positive; 1137 New_Item : Wide_String; 1138 Drop : Strings.Truncation := Strings.Error) return Super_String 1139 is 1140 Max_Length : constant Positive := Source.Max_Length; 1141 Result : Super_String (Max_Length); 1142 Endpos : constant Natural := Position + New_Item'Length - 1; 1143 Slen : constant Natural := Source.Current_Length; 1144 Droplen : Natural; 1145 1146 begin 1147 if Position > Slen + 1 then 1148 raise Ada.Strings.Index_Error; 1149 1150 elsif New_Item'Length = 0 then 1151 return Source; 1152 1153 elsif Endpos <= Slen then 1154 Result.Current_Length := Source.Current_Length; 1155 Result.Data (1 .. Slen) := Source.Data (1 .. Slen); 1156 Result.Data (Position .. Endpos) := New_Item; 1157 return Result; 1158 1159 elsif Endpos <= Max_Length then 1160 Result.Current_Length := Endpos; 1161 Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1); 1162 Result.Data (Position .. Endpos) := New_Item; 1163 return Result; 1164 1165 else 1166 Result.Current_Length := Max_Length; 1167 Droplen := Endpos - Max_Length; 1168 1169 case Drop is 1170 when Strings.Right => 1171 Result.Data (1 .. Position - 1) := 1172 Source.Data (1 .. Position - 1); 1173 1174 Result.Data (Position .. Max_Length) := 1175 New_Item (New_Item'First .. New_Item'Last - Droplen); 1176 return Result; 1177 1178 when Strings.Left => 1179 if New_Item'Length >= Max_Length then 1180 Result.Data (1 .. Max_Length) := 1181 New_Item (New_Item'Last - Max_Length + 1 .. 1182 New_Item'Last); 1183 return Result; 1184 1185 else 1186 Result.Data (1 .. Max_Length - New_Item'Length) := 1187 Source.Data (Droplen + 1 .. Position - 1); 1188 Result.Data 1189 (Max_Length - New_Item'Length + 1 .. Max_Length) := 1190 New_Item; 1191 return Result; 1192 end if; 1193 1194 when Strings.Error => 1195 raise Ada.Strings.Length_Error; 1196 end case; 1197 end if; 1198 end Super_Overwrite; 1199 1200 procedure Super_Overwrite 1201 (Source : in out Super_String; 1202 Position : Positive; 1203 New_Item : Wide_String; 1204 Drop : Strings.Truncation := Strings.Error) 1205 is 1206 Max_Length : constant Positive := Source.Max_Length; 1207 Endpos : constant Positive := Position + New_Item'Length - 1; 1208 Slen : constant Natural := Source.Current_Length; 1209 Droplen : Natural; 1210 1211 begin 1212 if Position > Slen + 1 then 1213 raise Ada.Strings.Index_Error; 1214 1215 elsif Endpos <= Slen then 1216 Source.Data (Position .. Endpos) := New_Item; 1217 1218 elsif Endpos <= Max_Length then 1219 Source.Data (Position .. Endpos) := New_Item; 1220 Source.Current_Length := Endpos; 1221 1222 else 1223 Source.Current_Length := Max_Length; 1224 Droplen := Endpos - Max_Length; 1225 1226 case Drop is 1227 when Strings.Right => 1228 Source.Data (Position .. Max_Length) := 1229 New_Item (New_Item'First .. New_Item'Last - Droplen); 1230 1231 when Strings.Left => 1232 if New_Item'Length > Max_Length then 1233 Source.Data (1 .. Max_Length) := 1234 New_Item (New_Item'Last - Max_Length + 1 .. 1235 New_Item'Last); 1236 1237 else 1238 Source.Data (1 .. Max_Length - New_Item'Length) := 1239 Source.Data (Droplen + 1 .. Position - 1); 1240 1241 Source.Data 1242 (Max_Length - New_Item'Length + 1 .. Max_Length) := 1243 New_Item; 1244 end if; 1245 1246 when Strings.Error => 1247 raise Ada.Strings.Length_Error; 1248 end case; 1249 end if; 1250 end Super_Overwrite; 1251 1252 --------------------------- 1253 -- Super_Replace_Element -- 1254 --------------------------- 1255 1256 procedure Super_Replace_Element 1257 (Source : in out Super_String; 1258 Index : Positive; 1259 By : Wide_Character) 1260 is 1261 begin 1262 if Index <= Source.Current_Length then 1263 Source.Data (Index) := By; 1264 else 1265 raise Ada.Strings.Index_Error; 1266 end if; 1267 end Super_Replace_Element; 1268 1269 ------------------------- 1270 -- Super_Replace_Slice -- 1271 ------------------------- 1272 1273 function Super_Replace_Slice 1274 (Source : Super_String; 1275 Low : Positive; 1276 High : Natural; 1277 By : Wide_String; 1278 Drop : Strings.Truncation := Strings.Error) return Super_String 1279 is 1280 Max_Length : constant Positive := Source.Max_Length; 1281 Slen : constant Natural := Source.Current_Length; 1282 1283 begin 1284 if Low > Slen + 1 then 1285 raise Strings.Index_Error; 1286 1287 elsif High < Low then 1288 return Super_Insert (Source, Low, By, Drop); 1289 1290 else 1291 declare 1292 Blen : constant Natural := Natural'Max (0, Low - 1); 1293 Alen : constant Natural := Natural'Max (0, Slen - High); 1294 Tlen : constant Natural := Blen + By'Length + Alen; 1295 Droplen : constant Integer := Tlen - Max_Length; 1296 Result : Super_String (Max_Length); 1297 1298 -- Tlen is the total length of the result string before any 1299 -- truncation. Blen and Alen are the lengths of the pieces 1300 -- of the original string that end up in the result string 1301 -- before and after the replaced slice. 1302 1303 begin 1304 if Droplen <= 0 then 1305 Result.Current_Length := Tlen; 1306 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1307 Result.Data (Low .. Low + By'Length - 1) := By; 1308 Result.Data (Low + By'Length .. Tlen) := 1309 Source.Data (High + 1 .. Slen); 1310 1311 else 1312 Result.Current_Length := Max_Length; 1313 1314 case Drop is 1315 when Strings.Right => 1316 Result.Data (1 .. Blen) := Source.Data (1 .. Blen); 1317 1318 if Droplen > Alen then 1319 Result.Data (Low .. Max_Length) := 1320 By (By'First .. By'First + Max_Length - Low); 1321 else 1322 Result.Data (Low .. Low + By'Length - 1) := By; 1323 Result.Data (Low + By'Length .. Max_Length) := 1324 Source.Data (High + 1 .. Slen - Droplen); 1325 end if; 1326 1327 when Strings.Left => 1328 Result.Data (Max_Length - (Alen - 1) .. Max_Length) := 1329 Source.Data (High + 1 .. Slen); 1330 1331 if Droplen >= Blen then 1332 Result.Data (1 .. Max_Length - Alen) := 1333 By (By'Last - (Max_Length - Alen) + 1 .. By'Last); 1334 else 1335 Result.Data 1336 (Blen - Droplen + 1 .. Max_Length - Alen) := By; 1337 Result.Data (1 .. Blen - Droplen) := 1338 Source.Data (Droplen + 1 .. Blen); 1339 end if; 1340 1341 when Strings.Error => 1342 raise Ada.Strings.Length_Error; 1343 end case; 1344 end if; 1345 1346 return Result; 1347 end; 1348 end if; 1349 end Super_Replace_Slice; 1350 1351 procedure Super_Replace_Slice 1352 (Source : in out Super_String; 1353 Low : Positive; 1354 High : Natural; 1355 By : Wide_String; 1356 Drop : Strings.Truncation := Strings.Error) 1357 is 1358 begin 1359 -- We do a double copy here because this is one of the situations 1360 -- in which we move data to the right, and at least at the moment, 1361 -- GNAT is not handling such cases correctly ??? 1362 1363 Source := Super_Replace_Slice (Source, Low, High, By, Drop); 1364 end Super_Replace_Slice; 1365 1366 --------------------- 1367 -- Super_Replicate -- 1368 --------------------- 1369 1370 function Super_Replicate 1371 (Count : Natural; 1372 Item : Wide_Character; 1373 Drop : Truncation := Error; 1374 Max_Length : Positive) return Super_String 1375 is 1376 Result : Super_String (Max_Length); 1377 1378 begin 1379 if Count <= Max_Length then 1380 Result.Current_Length := Count; 1381 1382 elsif Drop = Strings.Error then 1383 raise Ada.Strings.Length_Error; 1384 1385 else 1386 Result.Current_Length := Max_Length; 1387 end if; 1388 1389 Result.Data (1 .. Result.Current_Length) := (others => Item); 1390 return Result; 1391 end Super_Replicate; 1392 1393 function Super_Replicate 1394 (Count : Natural; 1395 Item : Wide_String; 1396 Drop : Truncation := Error; 1397 Max_Length : Positive) return Super_String 1398 is 1399 Length : constant Integer := Count * Item'Length; 1400 Result : Super_String (Max_Length); 1401 Indx : Positive; 1402 1403 begin 1404 if Length <= Max_Length then 1405 Result.Current_Length := Length; 1406 1407 if Length > 0 then 1408 Indx := 1; 1409 1410 for J in 1 .. Count loop 1411 Result.Data (Indx .. Indx + Item'Length - 1) := Item; 1412 Indx := Indx + Item'Length; 1413 end loop; 1414 end if; 1415 1416 else 1417 Result.Current_Length := Max_Length; 1418 1419 case Drop is 1420 when Strings.Right => 1421 Indx := 1; 1422 1423 while Indx + Item'Length <= Max_Length + 1 loop 1424 Result.Data (Indx .. Indx + Item'Length - 1) := Item; 1425 Indx := Indx + Item'Length; 1426 end loop; 1427 1428 Result.Data (Indx .. Max_Length) := 1429 Item (Item'First .. Item'First + Max_Length - Indx); 1430 1431 when Strings.Left => 1432 Indx := Max_Length; 1433 1434 while Indx - Item'Length >= 1 loop 1435 Result.Data (Indx - (Item'Length - 1) .. Indx) := Item; 1436 Indx := Indx - Item'Length; 1437 end loop; 1438 1439 Result.Data (1 .. Indx) := 1440 Item (Item'Last - Indx + 1 .. Item'Last); 1441 1442 when Strings.Error => 1443 raise Ada.Strings.Length_Error; 1444 end case; 1445 end if; 1446 1447 return Result; 1448 end Super_Replicate; 1449 1450 function Super_Replicate 1451 (Count : Natural; 1452 Item : Super_String; 1453 Drop : Strings.Truncation := Strings.Error) return Super_String 1454 is 1455 begin 1456 return 1457 Super_Replicate 1458 (Count, 1459 Item.Data (1 .. Item.Current_Length), 1460 Drop, 1461 Item.Max_Length); 1462 end Super_Replicate; 1463 1464 ----------------- 1465 -- Super_Slice -- 1466 ----------------- 1467 1468 function Super_Slice 1469 (Source : Super_String; 1470 Low : Positive; 1471 High : Natural) return Wide_String 1472 is 1473 begin 1474 -- Note: test of High > Length is in accordance with AI95-00128 1475 1476 return R : Wide_String (Low .. High) do 1477 if Low > Source.Current_Length + 1 1478 or else High > Source.Current_Length 1479 then 1480 raise Index_Error; 1481 end if; 1482 1483 R := Source.Data (Low .. High); 1484 end return; 1485 end Super_Slice; 1486 1487 function Super_Slice 1488 (Source : Super_String; 1489 Low : Positive; 1490 High : Natural) return Super_String 1491 is 1492 begin 1493 return Result : Super_String (Source.Max_Length) do 1494 if Low > Source.Current_Length + 1 1495 or else High > Source.Current_Length 1496 then 1497 raise Index_Error; 1498 end if; 1499 1500 Result.Current_Length := High - Low + 1; 1501 Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High); 1502 end return; 1503 end Super_Slice; 1504 1505 procedure Super_Slice 1506 (Source : Super_String; 1507 Target : out Super_String; 1508 Low : Positive; 1509 High : Natural) 1510 is 1511 begin 1512 if Low > Source.Current_Length + 1 1513 or else High > Source.Current_Length 1514 then 1515 raise Index_Error; 1516 else 1517 Target.Current_Length := High - Low + 1; 1518 Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); 1519 end if; 1520 end Super_Slice; 1521 1522 ---------------- 1523 -- Super_Tail -- 1524 ---------------- 1525 1526 function Super_Tail 1527 (Source : Super_String; 1528 Count : Natural; 1529 Pad : Wide_Character := Wide_Space; 1530 Drop : Strings.Truncation := Strings.Error) return Super_String 1531 is 1532 Max_Length : constant Positive := Source.Max_Length; 1533 Result : Super_String (Max_Length); 1534 Slen : constant Natural := Source.Current_Length; 1535 Npad : constant Integer := Count - Slen; 1536 1537 begin 1538 if Npad <= 0 then 1539 Result.Current_Length := Count; 1540 Result.Data (1 .. Count) := 1541 Source.Data (Slen - (Count - 1) .. Slen); 1542 1543 elsif Count <= Max_Length then 1544 Result.Current_Length := Count; 1545 Result.Data (1 .. Npad) := (others => Pad); 1546 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen); 1547 1548 else 1549 Result.Current_Length := Max_Length; 1550 1551 case Drop is 1552 when Strings.Right => 1553 if Npad >= Max_Length then 1554 Result.Data := (others => Pad); 1555 1556 else 1557 Result.Data (1 .. Npad) := (others => Pad); 1558 Result.Data (Npad + 1 .. Max_Length) := 1559 Source.Data (1 .. Max_Length - Npad); 1560 end if; 1561 1562 when Strings.Left => 1563 Result.Data (1 .. Max_Length - Slen) := (others => Pad); 1564 Result.Data (Max_Length - Slen + 1 .. Max_Length) := 1565 Source.Data (1 .. Slen); 1566 1567 when Strings.Error => 1568 raise Ada.Strings.Length_Error; 1569 end case; 1570 end if; 1571 1572 return Result; 1573 end Super_Tail; 1574 1575 procedure Super_Tail 1576 (Source : in out Super_String; 1577 Count : Natural; 1578 Pad : Wide_Character := Wide_Space; 1579 Drop : Truncation := Error) 1580 is 1581 Max_Length : constant Positive := Source.Max_Length; 1582 Slen : constant Natural := Source.Current_Length; 1583 Npad : constant Integer := Count - Slen; 1584 1585 Temp : constant Wide_String (1 .. Max_Length) := Source.Data; 1586 1587 begin 1588 if Npad <= 0 then 1589 Source.Current_Length := Count; 1590 Source.Data (1 .. Count) := 1591 Temp (Slen - (Count - 1) .. Slen); 1592 1593 elsif Count <= Max_Length then 1594 Source.Current_Length := Count; 1595 Source.Data (1 .. Npad) := (others => Pad); 1596 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen); 1597 1598 else 1599 Source.Current_Length := Max_Length; 1600 1601 case Drop is 1602 when Strings.Right => 1603 if Npad >= Max_Length then 1604 Source.Data := (others => Pad); 1605 1606 else 1607 Source.Data (1 .. Npad) := (others => Pad); 1608 Source.Data (Npad + 1 .. Max_Length) := 1609 Temp (1 .. Max_Length - Npad); 1610 end if; 1611 1612 when Strings.Left => 1613 for J in 1 .. Max_Length - Slen loop 1614 Source.Data (J) := Pad; 1615 end loop; 1616 1617 Source.Data (Max_Length - Slen + 1 .. Max_Length) := 1618 Temp (1 .. Slen); 1619 1620 when Strings.Error => 1621 raise Ada.Strings.Length_Error; 1622 end case; 1623 end if; 1624 end Super_Tail; 1625 1626 --------------------- 1627 -- Super_To_String -- 1628 --------------------- 1629 1630 function Super_To_String (Source : Super_String) return Wide_String is 1631 begin 1632 return R : Wide_String (1 .. Source.Current_Length) do 1633 R := Source.Data (1 .. Source.Current_Length); 1634 end return; 1635 end Super_To_String; 1636 1637 --------------------- 1638 -- Super_Translate -- 1639 --------------------- 1640 1641 function Super_Translate 1642 (Source : Super_String; 1643 Mapping : Wide_Maps.Wide_Character_Mapping) return Super_String 1644 is 1645 Result : Super_String (Source.Max_Length); 1646 1647 begin 1648 Result.Current_Length := Source.Current_Length; 1649 1650 for J in 1 .. Source.Current_Length loop 1651 Result.Data (J) := Value (Mapping, Source.Data (J)); 1652 end loop; 1653 1654 return Result; 1655 end Super_Translate; 1656 1657 procedure Super_Translate 1658 (Source : in out Super_String; 1659 Mapping : Wide_Maps.Wide_Character_Mapping) 1660 is 1661 begin 1662 for J in 1 .. Source.Current_Length loop 1663 Source.Data (J) := Value (Mapping, Source.Data (J)); 1664 end loop; 1665 end Super_Translate; 1666 1667 function Super_Translate 1668 (Source : Super_String; 1669 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Super_String 1670 is 1671 Result : Super_String (Source.Max_Length); 1672 1673 begin 1674 Result.Current_Length := Source.Current_Length; 1675 1676 for J in 1 .. Source.Current_Length loop 1677 Result.Data (J) := Mapping.all (Source.Data (J)); 1678 end loop; 1679 1680 return Result; 1681 end Super_Translate; 1682 1683 procedure Super_Translate 1684 (Source : in out Super_String; 1685 Mapping : Wide_Maps.Wide_Character_Mapping_Function) 1686 is 1687 begin 1688 for J in 1 .. Source.Current_Length loop 1689 Source.Data (J) := Mapping.all (Source.Data (J)); 1690 end loop; 1691 end Super_Translate; 1692 1693 ---------------- 1694 -- Super_Trim -- 1695 ---------------- 1696 1697 function Super_Trim 1698 (Source : Super_String; 1699 Side : Trim_End) return Super_String 1700 is 1701 Result : Super_String (Source.Max_Length); 1702 Last : Natural := Source.Current_Length; 1703 First : Positive := 1; 1704 1705 begin 1706 if Side = Left or else Side = Both then 1707 while First <= Last and then Source.Data (First) = ' ' loop 1708 First := First + 1; 1709 end loop; 1710 end if; 1711 1712 if Side = Right or else Side = Both then 1713 while Last >= First and then Source.Data (Last) = ' ' loop 1714 Last := Last - 1; 1715 end loop; 1716 end if; 1717 1718 Result.Current_Length := Last - First + 1; 1719 Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last); 1720 return Result; 1721 end Super_Trim; 1722 1723 procedure Super_Trim 1724 (Source : in out Super_String; 1725 Side : Trim_End) 1726 is 1727 Max_Length : constant Positive := Source.Max_Length; 1728 Last : Natural := Source.Current_Length; 1729 First : Positive := 1; 1730 Temp : Wide_String (1 .. Max_Length); 1731 1732 begin 1733 Temp (1 .. Last) := Source.Data (1 .. Last); 1734 1735 if Side = Left or else Side = Both then 1736 while First <= Last and then Temp (First) = ' ' loop 1737 First := First + 1; 1738 end loop; 1739 end if; 1740 1741 if Side = Right or else Side = Both then 1742 while Last >= First and then Temp (Last) = ' ' loop 1743 Last := Last - 1; 1744 end loop; 1745 end if; 1746 1747 Source.Data := (others => Wide_NUL); 1748 Source.Current_Length := Last - First + 1; 1749 Source.Data (1 .. Source.Current_Length) := Temp (First .. Last); 1750 end Super_Trim; 1751 1752 function Super_Trim 1753 (Source : Super_String; 1754 Left : Wide_Maps.Wide_Character_Set; 1755 Right : Wide_Maps.Wide_Character_Set) return Super_String 1756 is 1757 Result : Super_String (Source.Max_Length); 1758 1759 begin 1760 for First in 1 .. Source.Current_Length loop 1761 if not Is_In (Source.Data (First), Left) then 1762 for Last in reverse First .. Source.Current_Length loop 1763 if not Is_In (Source.Data (Last), Right) then 1764 Result.Current_Length := Last - First + 1; 1765 Result.Data (1 .. Result.Current_Length) := 1766 Source.Data (First .. Last); 1767 return Result; 1768 end if; 1769 end loop; 1770 end if; 1771 end loop; 1772 1773 Result.Current_Length := 0; 1774 return Result; 1775 end Super_Trim; 1776 1777 procedure Super_Trim 1778 (Source : in out Super_String; 1779 Left : Wide_Maps.Wide_Character_Set; 1780 Right : Wide_Maps.Wide_Character_Set) 1781 is 1782 begin 1783 for First in 1 .. Source.Current_Length loop 1784 if not Is_In (Source.Data (First), Left) then 1785 for Last in reverse First .. Source.Current_Length loop 1786 if not Is_In (Source.Data (Last), Right) then 1787 if First = 1 then 1788 Source.Current_Length := Last; 1789 return; 1790 else 1791 Source.Current_Length := Last - First + 1; 1792 Source.Data (1 .. Source.Current_Length) := 1793 Source.Data (First .. Last); 1794 1795 for J in Source.Current_Length + 1 .. 1796 Source.Max_Length 1797 loop 1798 Source.Data (J) := Wide_NUL; 1799 end loop; 1800 1801 return; 1802 end if; 1803 end if; 1804 end loop; 1805 1806 Source.Current_Length := 0; 1807 return; 1808 end if; 1809 end loop; 1810 1811 Source.Current_Length := 0; 1812 end Super_Trim; 1813 1814 ----------- 1815 -- Times -- 1816 ----------- 1817 1818 function Times 1819 (Left : Natural; 1820 Right : Wide_Character; 1821 Max_Length : Positive) return Super_String 1822 is 1823 Result : Super_String (Max_Length); 1824 1825 begin 1826 if Left > Max_Length then 1827 raise Ada.Strings.Length_Error; 1828 1829 else 1830 Result.Current_Length := Left; 1831 1832 for J in 1 .. Left loop 1833 Result.Data (J) := Right; 1834 end loop; 1835 end if; 1836 1837 return Result; 1838 end Times; 1839 1840 function Times 1841 (Left : Natural; 1842 Right : Wide_String; 1843 Max_Length : Positive) return Super_String 1844 is 1845 Result : Super_String (Max_Length); 1846 Pos : Positive := 1; 1847 Rlen : constant Natural := Right'Length; 1848 Nlen : constant Natural := Left * Rlen; 1849 1850 begin 1851 if Nlen > Max_Length then 1852 raise Ada.Strings.Index_Error; 1853 1854 else 1855 Result.Current_Length := Nlen; 1856 1857 if Nlen > 0 then 1858 for J in 1 .. Left loop 1859 Result.Data (Pos .. Pos + Rlen - 1) := Right; 1860 Pos := Pos + Rlen; 1861 end loop; 1862 end if; 1863 end if; 1864 1865 return Result; 1866 end Times; 1867 1868 function Times 1869 (Left : Natural; 1870 Right : Super_String) return Super_String 1871 is 1872 Result : Super_String (Right.Max_Length); 1873 Pos : Positive := 1; 1874 Rlen : constant Natural := Right.Current_Length; 1875 Nlen : constant Natural := Left * Rlen; 1876 1877 begin 1878 if Nlen > Right.Max_Length then 1879 raise Ada.Strings.Length_Error; 1880 1881 else 1882 Result.Current_Length := Nlen; 1883 1884 if Nlen > 0 then 1885 for J in 1 .. Left loop 1886 Result.Data (Pos .. Pos + Rlen - 1) := 1887 Right.Data (1 .. Rlen); 1888 Pos := Pos + Rlen; 1889 end loop; 1890 end if; 1891 end if; 1892 1893 return Result; 1894 end Times; 1895 1896 --------------------- 1897 -- To_Super_String -- 1898 --------------------- 1899 1900 function To_Super_String 1901 (Source : Wide_String; 1902 Max_Length : Natural; 1903 Drop : Truncation := Error) return Super_String 1904 is 1905 Result : Super_String (Max_Length); 1906 Slen : constant Natural := Source'Length; 1907 1908 begin 1909 if Slen <= Max_Length then 1910 Result.Current_Length := Slen; 1911 Result.Data (1 .. Slen) := Source; 1912 1913 else 1914 case Drop is 1915 when Strings.Right => 1916 Result.Current_Length := Max_Length; 1917 Result.Data (1 .. Max_Length) := 1918 Source (Source'First .. Source'First - 1 + Max_Length); 1919 1920 when Strings.Left => 1921 Result.Current_Length := Max_Length; 1922 Result.Data (1 .. Max_Length) := 1923 Source (Source'Last - (Max_Length - 1) .. Source'Last); 1924 1925 when Strings.Error => 1926 raise Ada.Strings.Length_Error; 1927 end case; 1928 end if; 1929 1930 return Result; 1931 end To_Super_String; 1932 1933end Ada.Strings.Wide_Superbounded; 1934