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