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