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