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