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