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