?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Improve max_insns_skipped logic
[official-gcc.git] / gcc / ada / a-strsup.adb
blob50df7dd48b4831cf9f8234919b1e6b7e84ad8190
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-2015, 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 -- Note: in this case, superflat bounds are not a problem, we just
1477 -- get the null string in accordance with normal Ada slice rules.
1478
1479 R := Source.Data (Low .. High);
1480 end return;
1481 end Super_Slice;
1482
1483 function Super_Slice
1484 (Source : Super_String;
1485 Low : Positive;
1486 High : Natural) return Super_String
1487 is
1488 begin
1489 return Result : Super_String (Source.Max_Length) do
1490 if Low > Source.Current_Length + 1
1491 or else High > Source.Current_Length
1492 then
1493 raise Index_Error;
1494 end if;
1495
1496 -- Note: the Max operation here deals with the superflat case
1497
1498 Result.Current_Length := Integer'Max (0, High - Low + 1);
1499 Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
1500 end return;
1501 end Super_Slice;
1502
1503 procedure Super_Slice
1504 (Source : Super_String;
1505 Target : out Super_String;
1506 Low : Positive;
1507 High : Natural)
1508 is
1509 begin
1510 if Low > Source.Current_Length + 1
1511 or else High > Source.Current_Length
1512 then
1513 raise Index_Error;
1514 end if;
1515
1516 -- Note: the Max operation here deals with the superflat case
1517
1518 Target.Current_Length := Integer'Max (0, High - Low + 1);
1519 Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High);
1520 end Super_Slice;
1521
1522 ----------------
1523 -- Super_Tail --
1524 ----------------
1525
1526 function Super_Tail
1527 (Source : Super_String;
1528 Count : Natural;
1529 Pad : Character := Space;
1530 Drop : Strings.Truncation := Strings.Error) return Super_String
1531 is
1532 Max_Length : constant Positive := Source.Max_Length;
1533 Result : Super_String (Max_Length);
1534 Slen : constant Natural := Source.Current_Length;
1535 Npad : constant Integer := Count - Slen;
1536
1537 begin
1538 if Npad <= 0 then
1539 Result.Current_Length := Count;
1540 Result.Data (1 .. Count) :=
1541 Source.Data (Slen - (Count - 1) .. Slen);
1542
1543 elsif Count <= Max_Length then
1544 Result.Current_Length := Count;
1545 Result.Data (1 .. Npad) := (others => Pad);
1546 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1547
1548 else
1549 Result.Current_Length := Max_Length;
1550
1551 case Drop is
1552 when Strings.Right =>
1553 if Npad >= Max_Length then
1554 Result.Data := (others => Pad);
1555
1556 else
1557 Result.Data (1 .. Npad) := (others => Pad);
1558 Result.Data (Npad + 1 .. Max_Length) :=
1559 Source.Data (1 .. Max_Length - Npad);
1560 end if;
1561
1562 when Strings.Left =>
1563 Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1564 Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1565 Source.Data (1 .. Slen);
1566
1567 when Strings.Error =>
1568 raise Ada.Strings.Length_Error;
1569 end case;
1570 end if;
1571
1572 return Result;
1573 end Super_Tail;
1574
1575 procedure Super_Tail
1576 (Source : in out Super_String;
1577 Count : Natural;
1578 Pad : Character := Space;
1579 Drop : Truncation := Error)
1580 is
1581 Max_Length : constant Positive := Source.Max_Length;
1582 Slen : constant Natural := Source.Current_Length;
1583 Npad : constant Integer := Count - Slen;
1584
1585 Temp : constant String (1 .. Max_Length) := Source.Data;
1586
1587 begin
1588 if Npad <= 0 then
1589 Source.Current_Length := Count;
1590 Source.Data (1 .. Count) :=
1591 Temp (Slen - (Count - 1) .. Slen);
1592
1593 elsif Count <= Max_Length then
1594 Source.Current_Length := Count;
1595 Source.Data (1 .. Npad) := (others => Pad);
1596 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1597
1598 else
1599 Source.Current_Length := Max_Length;
1600
1601 case Drop is
1602 when Strings.Right =>
1603 if Npad >= Max_Length then
1604 Source.Data := (others => Pad);
1605
1606 else
1607 Source.Data (1 .. Npad) := (others => Pad);
1608 Source.Data (Npad + 1 .. Max_Length) :=
1609 Temp (1 .. Max_Length - Npad);
1610 end if;
1611
1612 when Strings.Left =>
1613 for J in 1 .. Max_Length - Slen loop
1614 Source.Data (J) := Pad;
1615 end loop;
1616
1617 Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1618 Temp (1 .. Slen);
1619
1620 when Strings.Error =>
1621 raise Ada.Strings.Length_Error;
1622 end case;
1623 end if;
1624 end Super_Tail;
1625
1626 ---------------------
1627 -- Super_To_String --
1628 ---------------------
1629
1630 function Super_To_String (Source : Super_String) return String is
1631 begin
1632 return R : String (1 .. Source.Current_Length) do
1633 R := Source.Data (1 .. Source.Current_Length);
1634 end return;
1635 end Super_To_String;
1636
1637 ---------------------
1638 -- Super_Translate --
1639 ---------------------
1640
1641 function Super_Translate
1642 (Source : Super_String;
1643 Mapping : Maps.Character_Mapping) return Super_String
1644 is
1645 Result : Super_String (Source.Max_Length);
1646
1647 begin
1648 Result.Current_Length := Source.Current_Length;
1649
1650 for J in 1 .. Source.Current_Length loop
1651 Result.Data (J) := Value (Mapping, Source.Data (J));
1652 end loop;
1653
1654 return Result;
1655 end Super_Translate;
1656
1657 procedure Super_Translate
1658 (Source : in out Super_String;
1659 Mapping : Maps.Character_Mapping)
1660 is
1661 begin
1662 for J in 1 .. Source.Current_Length loop
1663 Source.Data (J) := Value (Mapping, Source.Data (J));
1664 end loop;
1665 end Super_Translate;
1666
1667 function Super_Translate
1668 (Source : Super_String;
1669 Mapping : Maps.Character_Mapping_Function) return Super_String
1670 is
1671 Result : Super_String (Source.Max_Length);
1672
1673 begin
1674 Result.Current_Length := Source.Current_Length;
1675
1676 for J in 1 .. Source.Current_Length loop
1677 Result.Data (J) := Mapping.all (Source.Data (J));
1678 end loop;
1679
1680 return Result;
1681 end Super_Translate;
1682
1683 procedure Super_Translate
1684 (Source : in out Super_String;
1685 Mapping : Maps.Character_Mapping_Function)
1686 is
1687 begin
1688 for J in 1 .. Source.Current_Length loop
1689 Source.Data (J) := Mapping.all (Source.Data (J));
1690 end loop;
1691 end Super_Translate;
1692
1693 ----------------
1694 -- Super_Trim --
1695 ----------------
1696
1697 function Super_Trim
1698 (Source : Super_String;
1699 Side : Trim_End) return Super_String
1700 is
1701 Result : Super_String (Source.Max_Length);
1702 Last : Natural := Source.Current_Length;
1703 First : Positive := 1;
1704
1705 begin
1706 if Side = Left or else Side = Both then
1707 while First <= Last and then Source.Data (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 Source.Data (Last) = ' ' loop
1714 Last := Last - 1;
1715 end loop;
1716 end if;
1717
1718 Result.Current_Length := Last - First + 1;
1719 Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last);
1720 return Result;
1721 end Super_Trim;
1722
1723 procedure Super_Trim
1724 (Source : in out Super_String;
1725 Side : Trim_End)
1726 is
1727 Max_Length : constant Positive := Source.Max_Length;
1728 Last : Natural := Source.Current_Length;
1729 First : Positive := 1;
1730 Temp : String (1 .. Max_Length);
1731
1732 begin
1733 Temp (1 .. Last) := Source.Data (1 .. Last);
1734
1735 if Side = Left or else Side = Both then
1736 while First <= Last and then Temp (First) = ' ' loop
1737 First := First + 1;
1738 end loop;
1739 end if;
1740
1741 if Side = Right or else Side = Both then
1742 while Last >= First and then Temp (Last) = ' ' loop
1743 Last := Last - 1;
1744 end loop;
1745 end if;
1746
1747 Source.Current_Length := Last - First + 1;
1748 Source.Data (1 .. Source.Current_Length) := Temp (First .. Last);
1749 end Super_Trim;
1750
1751 function Super_Trim
1752 (Source : Super_String;
1753 Left : Maps.Character_Set;
1754 Right : Maps.Character_Set) return Super_String
1755 is
1756 Result : Super_String (Source.Max_Length);
1757
1758 begin
1759 for First in 1 .. Source.Current_Length loop
1760 if not Is_In (Source.Data (First), Left) then
1761 for Last in reverse First .. Source.Current_Length loop
1762 if not Is_In (Source.Data (Last), Right) then
1763 Result.Current_Length := Last - First + 1;
1764 Result.Data (1 .. Result.Current_Length) :=
1765 Source.Data (First .. Last);
1766 return Result;
1767 end if;
1768 end loop;
1769 end if;
1770 end loop;
1771
1772 Result.Current_Length := 0;
1773 return Result;
1774 end Super_Trim;
1775
1776 procedure Super_Trim
1777 (Source : in out Super_String;
1778 Left : Maps.Character_Set;
1779 Right : Maps.Character_Set)
1780 is
1781 begin
1782 for First in 1 .. Source.Current_Length loop
1783 if not Is_In (Source.Data (First), Left) then
1784 for Last in reverse First .. Source.Current_Length loop
1785 if not Is_In (Source.Data (Last), Right) then
1786 if First = 1 then
1787 Source.Current_Length := Last;
1788 return;
1789 else
1790 Source.Current_Length := Last - First + 1;
1791 Source.Data (1 .. Source.Current_Length) :=
1792 Source.Data (First .. Last);
1793 return;
1794 end if;
1795 end if;
1796 end loop;
1797
1798 Source.Current_Length := 0;
1799 return;
1800 end if;
1801 end loop;
1802
1803 Source.Current_Length := 0;
1804 end Super_Trim;
1805
1806 -----------
1807 -- Times --
1808 -----------
1809
1810 function Times
1811 (Left : Natural;
1812 Right : Character;
1813 Max_Length : Positive) return Super_String
1814 is
1815 Result : Super_String (Max_Length);
1816
1817 begin
1818 if Left > Max_Length then
1819 raise Ada.Strings.Length_Error;
1820
1821 else
1822 Result.Current_Length := Left;
1823
1824 for J in 1 .. Left loop
1825 Result.Data (J) := Right;
1826 end loop;
1827 end if;
1828
1829 return Result;
1830 end Times;
1831
1832 function Times
1833 (Left : Natural;
1834 Right : String;
1835 Max_Length : Positive) return Super_String
1836 is
1837 Result : Super_String (Max_Length);
1838 Pos : Positive := 1;
1839 Rlen : constant Natural := Right'Length;
1840 Nlen : constant Natural := Left * Rlen;
1841
1842 begin
1843 if Nlen > Max_Length then
1844 raise Ada.Strings.Length_Error;
1845
1846 else
1847 Result.Current_Length := Nlen;
1848
1849 if Nlen > 0 then
1850 for J in 1 .. Left loop
1851 Result.Data (Pos .. Pos + Rlen - 1) := Right;
1852 Pos := Pos + Rlen;
1853 end loop;
1854 end if;
1855 end if;
1856
1857 return Result;
1858 end Times;
1859
1860 function Times
1861 (Left : Natural;
1862 Right : Super_String) return Super_String
1863 is
1864 Result : Super_String (Right.Max_Length);
1865 Pos : Positive := 1;
1866 Rlen : constant Natural := Right.Current_Length;
1867 Nlen : constant Natural := Left * Rlen;
1868
1869 begin
1870 if Nlen > Right.Max_Length then
1871 raise Ada.Strings.Length_Error;
1872
1873 else
1874 Result.Current_Length := Nlen;
1875
1876 if Nlen > 0 then
1877 for J in 1 .. Left loop
1878 Result.Data (Pos .. Pos + Rlen - 1) :=
1879 Right.Data (1 .. Rlen);
1880 Pos := Pos + Rlen;
1881 end loop;
1882 end if;
1883 end if;
1884
1885 return Result;
1886 end Times;
1887
1888 ---------------------
1889 -- To_Super_String --
1890 ---------------------
1891
1892 function To_Super_String
1893 (Source : String;
1894 Max_Length : Natural;
1895 Drop : Truncation := Error) return Super_String
1896 is
1897 Result : Super_String (Max_Length);
1898 Slen : constant Natural := Source'Length;
1899
1900 begin
1901 if Slen <= Max_Length then
1902 Result.Current_Length := Slen;
1903 Result.Data (1 .. Slen) := Source;
1904
1905 else
1906 case Drop is
1907 when Strings.Right =>
1908 Result.Current_Length := Max_Length;
1909 Result.Data (1 .. Max_Length) :=
1910 Source (Source'First .. Source'First - 1 + Max_Length);
1911
1912 when Strings.Left =>
1913 Result.Current_Length := Max_Length;
1914 Result.Data (1 .. Max_Length) :=
1915 Source (Source'Last - (Max_Length - 1) .. Source'Last);
1916
1917 when Strings.Error =>
1918 raise Ada.Strings.Length_Error;
1919 end case;
1920 end if;
1921
1922 return Result;
1923 end To_Super_String;
1924
1925 end Ada.Strings.Superbounded;
Mirror of the offical gcc git repository hosted at gcc.gnu.org