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