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