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