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