?  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-strsup.adb
blobf32398e71b0168336fed30c9aef7d3a751bde32d
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . 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.Maps; use Ada.Strings.Maps;
35 with Ada.Strings.Search;
36
37 package body Ada.Strings.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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : Truncation := 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 String
426
427 function Super_Append
428 (Left : Super_String;
429 Right : 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 : 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 String and Super_String
527
528 function Super_Append
529 (Left : 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 Character
581
582 function Super_Append
583 (Left : Super_String;
584 Right : 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 : 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 Character and Super_String
649
650 function Super_Append
651 (Left : 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 : String;
691 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
692 is
693 begin
694 return
695 Search.Count
696 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
697 end Super_Count;
698
699 function Super_Count
700 (Source : Super_String;
701 Pattern : String;
702 Mapping : Maps.Character_Mapping_Function) return Natural
703 is
704 begin
705 return
706 Search.Count
707 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
708 end Super_Count;
709
710 function Super_Count
711 (Source : Super_String;
712 Set : Maps.Character_Set) return Natural
713 is
714 begin
715 return Search.Count (Source.Data (1 .. Source.Current_Length), Set);
716 end Super_Count;
717
718 ------------------
719 -- Super_Delete --
720 ------------------
721
722 function Super_Delete
723 (Source : Super_String;
724 From : Positive;
725 Through : Natural) return Super_String
726 is
727 Result : Super_String (Source.Max_Length);
728 Slen : constant Natural := Source.Current_Length;
729 Num_Delete : constant Integer := Through - From + 1;
730
731 begin
732 if Num_Delete <= 0 then
733 return Source;
734
735 elsif From > Slen + 1 then
736 raise Ada.Strings.Index_Error;
737
738 elsif Through >= Slen then
739 Result.Current_Length := From - 1;
740 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
741 return Result;
742
743 else
744 Result.Current_Length := Slen - Num_Delete;
745 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
746 Result.Data (From .. Result.Current_Length) :=
747 Source.Data (Through + 1 .. Slen);
748 return Result;
749 end if;
750 end Super_Delete;
751
752 procedure Super_Delete
753 (Source : in out Super_String;
754 From : Positive;
755 Through : Natural)
756 is
757 Slen : constant Natural := Source.Current_Length;
758 Num_Delete : constant Integer := Through - From + 1;
759
760 begin
761 if Num_Delete <= 0 then
762 return;
763
764 elsif From > Slen + 1 then
765 raise Ada.Strings.Index_Error;
766
767 elsif Through >= Slen then
768 Source.Current_Length := From - 1;
769
770 else
771 Source.Current_Length := Slen - Num_Delete;
772 Source.Data (From .. Source.Current_Length) :=
773 Source.Data (Through + 1 .. Slen);
774 end if;
775 end Super_Delete;
776
777 -------------------
778 -- Super_Element --
779 -------------------
780
781 function Super_Element
782 (Source : Super_String;
783 Index : Positive) return Character
784 is
785 begin
786 if Index in 1 .. Source.Current_Length then
787 return Source.Data (Index);
788 else
789 raise Strings.Index_Error;
790 end if;
791 end Super_Element;
792
793 ----------------------
794 -- Super_Find_Token --
795 ----------------------
796
797 procedure Super_Find_Token
798 (Source : Super_String;
799 Set : Maps.Character_Set;
800 Test : Strings.Membership;
801 First : out Positive;
802 Last : out Natural)
803 is
804 begin
805 Search.Find_Token
806 (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last);
807 end Super_Find_Token;
808
809 ----------------
810 -- Super_Head --
811 ----------------
812
813 function Super_Head
814 (Source : Super_String;
815 Count : Natural;
816 Pad : Character := Space;
817 Drop : Strings.Truncation := Strings.Error) return Super_String
818 is
819 Max_Length : constant Positive := Source.Max_Length;
820 Result : Super_String (Max_Length);
821 Slen : constant Natural := Source.Current_Length;
822 Npad : constant Integer := Count - Slen;
823
824 begin
825 if Npad <= 0 then
826 Result.Current_Length := Count;
827 Result.Data (1 .. Count) := Source.Data (1 .. Count);
828
829 elsif Count <= Max_Length then
830 Result.Current_Length := Count;
831 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
832 Result.Data (Slen + 1 .. Count) := (others => Pad);
833
834 else
835 Result.Current_Length := Max_Length;
836
837 case Drop is
838 when Strings.Right =>
839 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
840 Result.Data (Slen + 1 .. Max_Length) := (others => Pad);
841
842 when Strings.Left =>
843 if Npad >= Max_Length then
844 Result.Data := (others => Pad);
845
846 else
847 Result.Data (1 .. Max_Length - Npad) :=
848 Source.Data (Count - Max_Length + 1 .. Slen);
849 Result.Data (Max_Length - Npad + 1 .. Max_Length) :=
850 (others => Pad);
851 end if;
852
853 when Strings.Error =>
854 raise Ada.Strings.Length_Error;
855 end case;
856 end if;
857
858 return Result;
859 end Super_Head;
860
861 procedure Super_Head
862 (Source : in out Super_String;
863 Count : Natural;
864 Pad : Character := Space;
865 Drop : Truncation := Error)
866 is
867 Max_Length : constant Positive := Source.Max_Length;
868 Slen : constant Natural := Source.Current_Length;
869 Npad : constant Integer := Count - Slen;
870 Temp : String (1 .. Max_Length);
871
872 begin
873 if Npad <= 0 then
874 Source.Current_Length := Count;
875
876 elsif Count <= Max_Length then
877 Source.Current_Length := Count;
878 Source.Data (Slen + 1 .. Count) := (others => Pad);
879
880 else
881 Source.Current_Length := Max_Length;
882
883 case Drop is
884 when Strings.Right =>
885 Source.Data (Slen + 1 .. Max_Length) := (others => Pad);
886
887 when Strings.Left =>
888 if Npad > Max_Length then
889 Source.Data := (others => Pad);
890
891 else
892 Temp := Source.Data;
893 Source.Data (1 .. Max_Length - Npad) :=
894 Temp (Count - Max_Length + 1 .. Slen);
895
896 for J in Max_Length - Npad + 1 .. Max_Length loop
897 Source.Data (J) := Pad;
898 end loop;
899 end if;
900
901 when Strings.Error =>
902 raise Ada.Strings.Length_Error;
903 end case;
904 end if;
905 end Super_Head;
906
907 -----------------
908 -- Super_Index --
909 -----------------
910
911 function Super_Index
912 (Source : Super_String;
913 Pattern : String;
914 Going : Strings.Direction := Strings.Forward;
915 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
916 is
917 begin
918 return Search.Index
919 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
920 end Super_Index;
921
922 function Super_Index
923 (Source : Super_String;
924 Pattern : String;
925 Going : Direction := Forward;
926 Mapping : Maps.Character_Mapping_Function) return Natural
927 is
928 begin
929 return Search.Index
930 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
931 end Super_Index;
932
933 function Super_Index
934 (Source : Super_String;
935 Set : Maps.Character_Set;
936 Test : Strings.Membership := Strings.Inside;
937 Going : Strings.Direction := Strings.Forward) return Natural
938 is
939 begin
940 return Search.Index
941 (Source.Data (1 .. Source.Current_Length), Set, Test, Going);
942 end Super_Index;
943
944 function Super_Index
945 (Source : Super_String;
946 Pattern : String;
947 From : Positive;
948 Going : Direction := Forward;
949 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
950 is
951 begin
952 return Search.Index
953 (Source.Data (1 .. Source.Current_Length),
954 Pattern, From, Going, Mapping);
955 end Super_Index;
956
957 function Super_Index
958 (Source : Super_String;
959 Pattern : String;
960 From : Positive;
961 Going : Direction := Forward;
962 Mapping : Maps.Character_Mapping_Function) return Natural
963 is
964 begin
965 return Search.Index
966 (Source.Data (1 .. Source.Current_Length),
967 Pattern, From, Going, Mapping);
968 end Super_Index;
969
970 function Super_Index
971 (Source : Super_String;
972 Set : Maps.Character_Set;
973 From : Positive;
974 Test : Membership := Inside;
975 Going : Direction := Forward) return Natural
976 is
977 begin
978 return Search.Index
979 (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going);
980 end Super_Index;
981
982 ---------------------------
983 -- Super_Index_Non_Blank --
984 ---------------------------
985
986 function Super_Index_Non_Blank
987 (Source : Super_String;
988 Going : Strings.Direction := Strings.Forward) return Natural
989 is
990 begin
991 return
992 Search.Index_Non_Blank
993 (Source.Data (1 .. Source.Current_Length), Going);
994 end Super_Index_Non_Blank;
995
996 function Super_Index_Non_Blank
997 (Source : Super_String;
998 From : Positive;
999 Going : Direction := Forward) return Natural
1000 is
1001 begin
1002 return
1003 Search.Index_Non_Blank
1004 (Source.Data (1 .. Source.Current_Length), From, Going);
1005 end Super_Index_Non_Blank;
1006
1007 ------------------
1008 -- Super_Insert --
1009 ------------------
1010
1011 function Super_Insert
1012 (Source : Super_String;
1013 Before : Positive;
1014 New_Item : String;
1015 Drop : Strings.Truncation := Strings.Error) return Super_String
1016 is
1017 Max_Length : constant Positive := Source.Max_Length;
1018 Result : Super_String (Max_Length);
1019 Slen : constant Natural := Source.Current_Length;
1020 Nlen : constant Natural := New_Item'Length;
1021 Tlen : constant Natural := Slen + Nlen;
1022 Blen : constant Natural := Before - 1;
1023 Alen : constant Integer := Slen - Blen;
1024 Droplen : constant Integer := Tlen - Max_Length;
1025
1026 -- Tlen is the length of the total string before possible truncation.
1027 -- Blen, Alen are the lengths of the before and after pieces of the
1028 -- source string.
1029
1030 begin
1031 if Alen < 0 then
1032 raise Ada.Strings.Index_Error;
1033
1034 elsif Droplen <= 0 then
1035 Result.Current_Length := Tlen;
1036 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1037 Result.Data (Before .. Before + Nlen - 1) := New_Item;
1038 Result.Data (Before + Nlen .. Tlen) :=
1039 Source.Data (Before .. Slen);
1040
1041 else
1042 Result.Current_Length := Max_Length;
1043
1044 case Drop is
1045 when Strings.Right =>
1046 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1047
1048 if Droplen > Alen then
1049 Result.Data (Before .. Max_Length) :=
1050 New_Item (New_Item'First
1051 .. New_Item'First + Max_Length - Before);
1052 else
1053 Result.Data (Before .. Before + Nlen - 1) := New_Item;
1054 Result.Data (Before + Nlen .. Max_Length) :=
1055 Source.Data (Before .. Slen - Droplen);
1056 end if;
1057
1058 when Strings.Left =>
1059 Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1060 Source.Data (Before .. Slen);
1061
1062 if Droplen >= Blen then
1063 Result.Data (1 .. Max_Length - Alen) :=
1064 New_Item (New_Item'Last - (Max_Length - Alen) + 1
1065 .. New_Item'Last);
1066 else
1067 Result.Data
1068 (Blen - Droplen + 1 .. Max_Length - Alen) :=
1069 New_Item;
1070 Result.Data (1 .. Blen - Droplen) :=
1071 Source.Data (Droplen + 1 .. Blen);
1072 end if;
1073
1074 when Strings.Error =>
1075 raise Ada.Strings.Length_Error;
1076 end case;
1077 end if;
1078
1079 return Result;
1080 end Super_Insert;
1081
1082 procedure Super_Insert
1083 (Source : in out Super_String;
1084 Before : Positive;
1085 New_Item : String;
1086 Drop : Strings.Truncation := Strings.Error)
1087 is
1088 begin
1089 -- We do a double copy here because this is one of the situations
1090 -- in which we move data to the right, and at least at the moment,
1091 -- GNAT is not handling such cases correctly ???
1092
1093 Source := Super_Insert (Source, Before, New_Item, Drop);
1094 end Super_Insert;
1095
1096 ------------------
1097 -- Super_Length --
1098 ------------------
1099
1100 function Super_Length (Source : Super_String) return Natural is
1101 begin
1102 return Source.Current_Length;
1103 end Super_Length;
1104
1105 ---------------------
1106 -- Super_Overwrite --
1107 ---------------------
1108
1109 function Super_Overwrite
1110 (Source : Super_String;
1111 Position : Positive;
1112 New_Item : String;
1113 Drop : Strings.Truncation := Strings.Error) return Super_String
1114 is
1115 Max_Length : constant Positive := Source.Max_Length;
1116 Result : Super_String (Max_Length);
1117 Endpos : constant Natural := Position + New_Item'Length - 1;
1118 Slen : constant Natural := Source.Current_Length;
1119 Droplen : Natural;
1120
1121 begin
1122 if Position > Slen + 1 then
1123 raise Ada.Strings.Index_Error;
1124
1125 elsif New_Item'Length = 0 then
1126 return Source;
1127
1128 elsif Endpos <= Slen then
1129 Result.Current_Length := Source.Current_Length;
1130 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
1131 Result.Data (Position .. Endpos) := New_Item;
1132 return Result;
1133
1134 elsif Endpos <= Max_Length then
1135 Result.Current_Length := Endpos;
1136 Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1);
1137 Result.Data (Position .. Endpos) := New_Item;
1138 return Result;
1139
1140 else
1141 Result.Current_Length := Max_Length;
1142 Droplen := Endpos - Max_Length;
1143
1144 case Drop is
1145 when Strings.Right =>
1146 Result.Data (1 .. Position - 1) :=
1147 Source.Data (1 .. Position - 1);
1148
1149 Result.Data (Position .. Max_Length) :=
1150 New_Item (New_Item'First .. New_Item'Last - Droplen);
1151 return Result;
1152
1153 when Strings.Left =>
1154 if New_Item'Length >= Max_Length then
1155 Result.Data (1 .. Max_Length) :=
1156 New_Item (New_Item'Last - Max_Length + 1 ..
1157 New_Item'Last);
1158 return Result;
1159
1160 else
1161 Result.Data (1 .. Max_Length - New_Item'Length) :=
1162 Source.Data (Droplen + 1 .. Position - 1);
1163 Result.Data
1164 (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1165 New_Item;
1166 return Result;
1167 end if;
1168
1169 when Strings.Error =>
1170 raise Ada.Strings.Length_Error;
1171 end case;
1172 end if;
1173 end Super_Overwrite;
1174
1175 procedure Super_Overwrite
1176 (Source : in out Super_String;
1177 Position : Positive;
1178 New_Item : String;
1179 Drop : Strings.Truncation := Strings.Error)
1180 is
1181 Max_Length : constant Positive := Source.Max_Length;
1182 Endpos : constant Positive := Position + New_Item'Length - 1;
1183 Slen : constant Natural := Source.Current_Length;
1184 Droplen : Natural;
1185
1186 begin
1187 if Position > Slen + 1 then
1188 raise Ada.Strings.Index_Error;
1189
1190 elsif Endpos <= Slen then
1191 Source.Data (Position .. Endpos) := New_Item;
1192
1193 elsif Endpos <= Max_Length then
1194 Source.Data (Position .. Endpos) := New_Item;
1195 Source.Current_Length := Endpos;
1196
1197 else
1198 Source.Current_Length := Max_Length;
1199 Droplen := Endpos - Max_Length;
1200
1201 case Drop is
1202 when Strings.Right =>
1203 Source.Data (Position .. Max_Length) :=
1204 New_Item (New_Item'First .. New_Item'Last - Droplen);
1205
1206 when Strings.Left =>
1207 if New_Item'Length > Max_Length then
1208 Source.Data (1 .. Max_Length) :=
1209 New_Item (New_Item'Last - Max_Length + 1 ..
1210 New_Item'Last);
1211
1212 else
1213 Source.Data (1 .. Max_Length - New_Item'Length) :=
1214 Source.Data (Droplen + 1 .. Position - 1);
1215
1216 Source.Data
1217 (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1218 New_Item;
1219 end if;
1220
1221 when Strings.Error =>
1222 raise Ada.Strings.Length_Error;
1223 end case;
1224 end if;
1225 end Super_Overwrite;
1226
1227 ---------------------------
1228 -- Super_Replace_Element --
1229 ---------------------------
1230
1231 procedure Super_Replace_Element
1232 (Source : in out Super_String;
1233 Index : Positive;
1234 By : Character)
1235 is
1236 begin
1237 if Index <= Source.Current_Length then
1238 Source.Data (Index) := By;
1239 else
1240 raise Ada.Strings.Index_Error;
1241 end if;
1242 end Super_Replace_Element;
1243
1244 -------------------------
1245 -- Super_Replace_Slice --
1246 -------------------------
1247
1248 function Super_Replace_Slice
1249 (Source : Super_String;
1250 Low : Positive;
1251 High : Natural;
1252 By : String;
1253 Drop : Strings.Truncation := Strings.Error) return Super_String
1254 is
1255 Max_Length : constant Positive := Source.Max_Length;
1256 Slen : constant Natural := Source.Current_Length;
1257
1258 begin
1259 if Low > Slen + 1 then
1260 raise Strings.Index_Error;
1261
1262 elsif High < Low then
1263 return Super_Insert (Source, Low, By, Drop);
1264
1265 else
1266 declare
1267 Blen : constant Natural := Natural'Max (0, Low - 1);
1268 Alen : constant Natural := Natural'Max (0, Slen - High);
1269 Tlen : constant Natural := Blen + By'Length + Alen;
1270 Droplen : constant Integer := Tlen - Max_Length;
1271 Result : Super_String (Max_Length);
1272
1273 -- Tlen is the total length of the result string before any
1274 -- truncation. Blen and Alen are the lengths of the pieces
1275 -- of the original string that end up in the result string
1276 -- before and after the replaced slice.
1277
1278 begin
1279 if Droplen <= 0 then
1280 Result.Current_Length := Tlen;
1281 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1282 Result.Data (Low .. Low + By'Length - 1) := By;
1283 Result.Data (Low + By'Length .. Tlen) :=
1284 Source.Data (High + 1 .. Slen);
1285
1286 else
1287 Result.Current_Length := Max_Length;
1288
1289 case Drop is
1290 when Strings.Right =>
1291 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1292
1293 if Droplen > Alen then
1294 Result.Data (Low .. Max_Length) :=
1295 By (By'First .. By'First + Max_Length - Low);
1296 else
1297 Result.Data (Low .. Low + By'Length - 1) := By;
1298 Result.Data (Low + By'Length .. Max_Length) :=
1299 Source.Data (High + 1 .. Slen - Droplen);
1300 end if;
1301
1302 when Strings.Left =>
1303 Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1304 Source.Data (High + 1 .. Slen);
1305
1306 if Droplen >= Blen then
1307 Result.Data (1 .. Max_Length - Alen) :=
1308 By (By'Last - (Max_Length - Alen) + 1 .. By'Last);
1309 else
1310 Result.Data
1311 (Blen - Droplen + 1 .. Max_Length - Alen) := By;
1312 Result.Data (1 .. Blen - Droplen) :=
1313 Source.Data (Droplen + 1 .. Blen);
1314 end if;
1315
1316 when Strings.Error =>
1317 raise Ada.Strings.Length_Error;
1318 end case;
1319 end if;
1320
1321 return Result;
1322 end;
1323 end if;
1324 end Super_Replace_Slice;
1325
1326 procedure Super_Replace_Slice
1327 (Source : in out Super_String;
1328 Low : Positive;
1329 High : Natural;
1330 By : String;
1331 Drop : Strings.Truncation := Strings.Error)
1332 is
1333 begin
1334 -- We do a double copy here because this is one of the situations
1335 -- in which we move data to the right, and at least at the moment,
1336 -- GNAT is not handling such cases correctly ???
1337
1338 Source := Super_Replace_Slice (Source, Low, High, By, Drop);
1339 end Super_Replace_Slice;
1340
1341 ---------------------
1342 -- Super_Replicate --
1343 ---------------------
1344
1345 function Super_Replicate
1346 (Count : Natural;
1347 Item : Character;
1348 Drop : Truncation := Error;
1349 Max_Length : Positive) return Super_String
1350 is
1351 Result : Super_String (Max_Length);
1352
1353 begin
1354 if Count <= Max_Length then
1355 Result.Current_Length := Count;
1356
1357 elsif Drop = Strings.Error then
1358 raise Ada.Strings.Length_Error;
1359
1360 else
1361 Result.Current_Length := Max_Length;
1362 end if;
1363
1364 Result.Data (1 .. Result.Current_Length) := (others => Item);
1365 return Result;
1366 end Super_Replicate;
1367
1368 function Super_Replicate
1369 (Count : Natural;
1370 Item : String;
1371 Drop : Truncation := Error;
1372 Max_Length : Positive) return Super_String
1373 is
1374 Length : constant Integer := Count * Item'Length;
1375 Result : Super_String (Max_Length);
1376 Indx : Positive;
1377
1378 begin
1379 if Length <= Max_Length then
1380 Result.Current_Length := Length;
1381
1382 if Length > 0 then
1383 Indx := 1;
1384
1385 for J in 1 .. Count loop
1386 Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1387 Indx := Indx + Item'Length;
1388 end loop;
1389 end if;
1390
1391 else
1392 Result.Current_Length := Max_Length;
1393
1394 case Drop is
1395 when Strings.Right =>
1396 Indx := 1;
1397
1398 while Indx + Item'Length <= Max_Length + 1 loop
1399 Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1400 Indx := Indx + Item'Length;
1401 end loop;
1402
1403 Result.Data (Indx .. Max_Length) :=
1404 Item (Item'First .. Item'First + Max_Length - Indx);
1405
1406 when Strings.Left =>
1407 Indx := Max_Length;
1408
1409 while Indx - Item'Length >= 1 loop
1410 Result.Data (Indx - (Item'Length - 1) .. Indx) := Item;
1411 Indx := Indx - Item'Length;
1412 end loop;
1413
1414 Result.Data (1 .. Indx) :=
1415 Item (Item'Last - Indx + 1 .. Item'Last);
1416
1417 when Strings.Error =>
1418 raise Ada.Strings.Length_Error;
1419 end case;
1420 end if;
1421
1422 return Result;
1423 end Super_Replicate;
1424
1425 function Super_Replicate
1426 (Count : Natural;
1427 Item : Super_String;
1428 Drop : Strings.Truncation := Strings.Error) return Super_String
1429 is
1430 begin
1431 return
1432 Super_Replicate
1433 (Count,
1434 Item.Data (1 .. Item.Current_Length),
1435 Drop,
1436 Item.Max_Length);
1437 end Super_Replicate;
1438
1439 -----------------
1440 -- Super_Slice --
1441 -----------------
1442
1443 function Super_Slice
1444 (Source : Super_String;
1445 Low : Positive;
1446 High : Natural) return String
1447 is
1448 begin
1449 -- Note: test of High > Length is in accordance with AI95-00128
1450
1451 if Low > Source.Current_Length + 1
1452 or else High > Source.Current_Length
1453 then
1454 raise Index_Error;
1455 else
1456 return Source.Data (Low .. High);
1457 end if;
1458 end Super_Slice;
1459
1460 function Super_Slice
1461 (Source : Super_String;
1462 Low : Positive;
1463 High : Natural) return Super_String
1464 is
1465 Result : Super_String (Source.Max_Length);
1466
1467 begin
1468 if Low > Source.Current_Length + 1
1469 or else High > Source.Current_Length
1470 then
1471 raise Index_Error;
1472 else
1473 Result.Current_Length := High - Low + 1;
1474 Result.Data (1 .. Source.Current_Length) := Source.Data (Low .. High);
1475 end if;
1476
1477 return Result;
1478 end Super_Slice;
1479
1480 procedure Super_Slice
1481 (Source : Super_String;
1482 Target : out Super_String;
1483 Low : Positive;
1484 High : Natural)
1485 is
1486 begin
1487 if Low > Source.Current_Length + 1
1488 or else High > Source.Current_Length
1489 then
1490 raise Index_Error;
1491 else
1492 Target.Current_Length := High - Low + 1;
1493 Target.Data (1 .. Source.Current_Length) := Source.Data (Low .. High);
1494 end if;
1495 end Super_Slice;
1496
1497 ----------------
1498 -- Super_Tail --
1499 ----------------
1500
1501 function Super_Tail
1502 (Source : Super_String;
1503 Count : Natural;
1504 Pad : Character := Space;
1505 Drop : Strings.Truncation := Strings.Error) return Super_String
1506 is
1507 Max_Length : constant Positive := Source.Max_Length;
1508 Result : Super_String (Max_Length);
1509 Slen : constant Natural := Source.Current_Length;
1510 Npad : constant Integer := Count - Slen;
1511
1512 begin
1513 if Npad <= 0 then
1514 Result.Current_Length := Count;
1515 Result.Data (1 .. Count) :=
1516 Source.Data (Slen - (Count - 1) .. Slen);
1517
1518 elsif Count <= Max_Length then
1519 Result.Current_Length := Count;
1520 Result.Data (1 .. Npad) := (others => Pad);
1521 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1522
1523 else
1524 Result.Current_Length := Max_Length;
1525
1526 case Drop is
1527 when Strings.Right =>
1528 if Npad >= Max_Length then
1529 Result.Data := (others => Pad);
1530
1531 else
1532 Result.Data (1 .. Npad) := (others => Pad);
1533 Result.Data (Npad + 1 .. Max_Length) :=
1534 Source.Data (1 .. Max_Length - Npad);
1535 end if;
1536
1537 when Strings.Left =>
1538 Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1539 Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1540 Source.Data (1 .. Slen);
1541
1542 when Strings.Error =>
1543 raise Ada.Strings.Length_Error;
1544 end case;
1545 end if;
1546
1547 return Result;
1548 end Super_Tail;
1549
1550 procedure Super_Tail
1551 (Source : in out Super_String;
1552 Count : Natural;
1553 Pad : Character := Space;
1554 Drop : Truncation := Error)
1555 is
1556 Max_Length : constant Positive := Source.Max_Length;
1557 Slen : constant Natural := Source.Current_Length;
1558 Npad : constant Integer := Count - Slen;
1559
1560 Temp : constant String (1 .. Max_Length) := Source.Data;
1561
1562 begin
1563 if Npad <= 0 then
1564 Source.Current_Length := Count;
1565 Source.Data (1 .. Count) :=
1566 Temp (Slen - (Count - 1) .. Slen);
1567
1568 elsif Count <= Max_Length then
1569 Source.Current_Length := Count;
1570 Source.Data (1 .. Npad) := (others => Pad);
1571 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1572
1573 else
1574 Source.Current_Length := Max_Length;
1575
1576 case Drop is
1577 when Strings.Right =>
1578 if Npad >= Max_Length then
1579 Source.Data := (others => Pad);
1580
1581 else
1582 Source.Data (1 .. Npad) := (others => Pad);
1583 Source.Data (Npad + 1 .. Max_Length) :=
1584 Temp (1 .. Max_Length - Npad);
1585 end if;
1586
1587 when Strings.Left =>
1588 for J in 1 .. Max_Length - Slen loop
1589 Source.Data (J) := Pad;
1590 end loop;
1591
1592 Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1593 Temp (1 .. Slen);
1594
1595 when Strings.Error =>
1596 raise Ada.Strings.Length_Error;
1597 end case;
1598 end if;
1599 end Super_Tail;
1600
1601 ---------------------
1602 -- Super_To_String --
1603 ---------------------
1604
1605 function Super_To_String (Source : Super_String) return String is
1606 begin
1607 return Source.Data (1 .. Source.Current_Length);
1608 end Super_To_String;
1609
1610 ---------------------
1611 -- Super_Translate --
1612 ---------------------
1613
1614 function Super_Translate
1615 (Source : Super_String;
1616 Mapping : Maps.Character_Mapping) return Super_String
1617 is
1618 Result : Super_String (Source.Max_Length);
1619
1620 begin
1621 Result.Current_Length := Source.Current_Length;
1622
1623 for J in 1 .. Source.Current_Length loop
1624 Result.Data (J) := Value (Mapping, Source.Data (J));
1625 end loop;
1626
1627 return Result;
1628 end Super_Translate;
1629
1630 procedure Super_Translate
1631 (Source : in out Super_String;
1632 Mapping : Maps.Character_Mapping)
1633 is
1634 begin
1635 for J in 1 .. Source.Current_Length loop
1636 Source.Data (J) := Value (Mapping, Source.Data (J));
1637 end loop;
1638 end Super_Translate;
1639
1640 function Super_Translate
1641 (Source : Super_String;
1642 Mapping : Maps.Character_Mapping_Function) return Super_String
1643 is
1644 Result : Super_String (Source.Max_Length);
1645
1646 begin
1647 Result.Current_Length := Source.Current_Length;
1648
1649 for J in 1 .. Source.Current_Length loop
1650 Result.Data (J) := Mapping.all (Source.Data (J));
1651 end loop;
1652
1653 return Result;
1654 end Super_Translate;
1655
1656 procedure Super_Translate
1657 (Source : in out Super_String;
1658 Mapping : Maps.Character_Mapping_Function)
1659 is
1660 begin
1661 for J in 1 .. Source.Current_Length loop
1662 Source.Data (J) := Mapping.all (Source.Data (J));
1663 end loop;
1664 end Super_Translate;
1665
1666 ----------------
1667 -- Super_Trim --
1668 ----------------
1669
1670 function Super_Trim
1671 (Source : Super_String;
1672 Side : Trim_End) return Super_String
1673 is
1674 Result : Super_String (Source.Max_Length);
1675 Last : Natural := Source.Current_Length;
1676 First : Positive := 1;
1677
1678 begin
1679 if Side = Left or else Side = Both then
1680 while First <= Last and then Source.Data (First) = ' ' loop
1681 First := First + 1;
1682 end loop;
1683 end if;
1684
1685 if Side = Right or else Side = Both then
1686 while Last >= First and then Source.Data (Last) = ' ' loop
1687 Last := Last - 1;
1688 end loop;
1689 end if;
1690
1691 Result.Current_Length := Last - First + 1;
1692 Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last);
1693 return Result;
1694 end Super_Trim;
1695
1696 procedure Super_Trim
1697 (Source : in out Super_String;
1698 Side : Trim_End)
1699 is
1700 Max_Length : constant Positive := Source.Max_Length;
1701 Last : Natural := Source.Current_Length;
1702 First : Positive := 1;
1703 Temp : String (1 .. Max_Length);
1704
1705 begin
1706 Temp (1 .. Last) := Source.Data (1 .. Last);
1707
1708 if Side = Left or else Side = Both then
1709 while First <= Last and then Temp (First) = ' ' loop
1710 First := First + 1;
1711 end loop;
1712 end if;
1713
1714 if Side = Right or else Side = Both then
1715 while Last >= First and then Temp (Last) = ' ' loop
1716 Last := Last - 1;
1717 end loop;
1718 end if;
1719
1720 Source.Data := (others => ASCII.NUL);
1721 Source.Current_Length := Last - First + 1;
1722 Source.Data (1 .. Source.Current_Length) := Temp (First .. Last);
1723 end Super_Trim;
1724
1725 function Super_Trim
1726 (Source : Super_String;
1727 Left : Maps.Character_Set;
1728 Right : Maps.Character_Set) return Super_String
1729 is
1730 Result : Super_String (Source.Max_Length);
1731
1732 begin
1733 for First in 1 .. Source.Current_Length loop
1734 if not Is_In (Source.Data (First), Left) then
1735 for Last in reverse First .. Source.Current_Length loop
1736 if not Is_In (Source.Data (Last), Right) then
1737 Result.Current_Length := Last - First + 1;
1738 Result.Data (1 .. Result.Current_Length) :=
1739 Source.Data (First .. Last);
1740 return Result;
1741 end if;
1742 end loop;
1743 end if;
1744 end loop;
1745
1746 Result.Current_Length := 0;
1747 return Result;
1748 end Super_Trim;
1749
1750 procedure Super_Trim
1751 (Source : in out Super_String;
1752 Left : Maps.Character_Set;
1753 Right : Maps.Character_Set)
1754 is
1755 begin
1756 for First in 1 .. Source.Current_Length loop
1757 if not Is_In (Source.Data (First), Left) then
1758 for Last in reverse First .. Source.Current_Length loop
1759 if not Is_In (Source.Data (Last), Right) then
1760 if First = 1 then
1761 Source.Current_Length := Last;
1762 return;
1763 else
1764 Source.Current_Length := Last - First + 1;
1765 Source.Data (1 .. Source.Current_Length) :=
1766 Source.Data (First .. Last);
1767
1768 for J in Source.Current_Length + 1 ..
1769 Source.Max_Length
1770 loop
1771 Source.Data (J) := ASCII.NUL;
1772 end loop;
1773
1774 return;
1775 end if;
1776 end if;
1777 end loop;
1778
1779 Source.Current_Length := 0;
1780 return;
1781 end if;
1782 end loop;
1783
1784 Source.Current_Length := 0;
1785 end Super_Trim;
1786
1787 -----------
1788 -- Times --
1789 -----------
1790
1791 function Times
1792 (Left : Natural;
1793 Right : Character;
1794 Max_Length : Positive) return Super_String
1795 is
1796 Result : Super_String (Max_Length);
1797
1798 begin
1799 if Left > Max_Length then
1800 raise Ada.Strings.Length_Error;
1801
1802 else
1803 Result.Current_Length := Left;
1804
1805 for J in 1 .. Left loop
1806 Result.Data (J) := Right;
1807 end loop;
1808 end if;
1809
1810 return Result;
1811 end Times;
1812
1813 function Times
1814 (Left : Natural;
1815 Right : String;
1816 Max_Length : Positive) return Super_String
1817 is
1818 Result : Super_String (Max_Length);
1819 Pos : Positive := 1;
1820 Rlen : constant Natural := Right'Length;
1821 Nlen : constant Natural := Left * Rlen;
1822
1823 begin
1824 if Nlen > Max_Length then
1825 raise Ada.Strings.Index_Error;
1826
1827 else
1828 Result.Current_Length := Nlen;
1829
1830 if Nlen > 0 then
1831 for J in 1 .. Left loop
1832 Result.Data (Pos .. Pos + Rlen - 1) := Right;
1833 Pos := Pos + Rlen;
1834 end loop;
1835 end if;
1836 end if;
1837
1838 return Result;
1839 end Times;
1840
1841 function Times
1842 (Left : Natural;
1843 Right : Super_String) return Super_String
1844 is
1845 Result : Super_String (Right.Max_Length);
1846 Pos : Positive := 1;
1847 Rlen : constant Natural := Right.Current_Length;
1848 Nlen : constant Natural := Left * Rlen;
1849
1850 begin
1851 if Nlen > Right.Max_Length then
1852 raise Ada.Strings.Length_Error;
1853
1854 else
1855 Result.Current_Length := Nlen;
1856
1857 if Nlen > 0 then
1858 for J in 1 .. Left loop
1859 Result.Data (Pos .. Pos + Rlen - 1) :=
1860 Right.Data (1 .. Rlen);
1861 Pos := Pos + Rlen;
1862 end loop;
1863 end if;
1864 end if;
1865
1866 return Result;
1867 end Times;
1868
1869 ---------------------
1870 -- To_Super_String --
1871 ---------------------
1872
1873 function To_Super_String
1874 (Source : String;
1875 Max_Length : Natural;
1876 Drop : Truncation := Error) return Super_String
1877 is
1878 Result : Super_String (Max_Length);
1879 Slen : constant Natural := Source'Length;
1880
1881 begin
1882 if Slen <= Max_Length then
1883 Result.Current_Length := Slen;
1884 Result.Data (1 .. Slen) := Source;
1885
1886 else
1887 case Drop is
1888 when Strings.Right =>
1889 Result.Current_Length := Max_Length;
1890 Result.Data (1 .. Max_Length) :=
1891 Source (Source'First .. Source'First - 1 + Max_Length);
1892
1893 when Strings.Left =>
1894 Result.Current_Length := Max_Length;
1895 Result.Data (1 .. Max_Length) :=
1896 Source (Source'Last - (Max_Length - 1) .. Source'Last);
1897
1898 when Strings.Error =>
1899 raise Ada.Strings.Length_Error;
1900 end case;
1901 end if;
1902
1903 return Result;
1904 end To_Super_String;
1905
1906 end Ada.Strings.Superbounded;
Mirror of the offical gcc git repository hosted at gcc.gnu.org