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