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