?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merge from mainline (167278:168000).
[official-gcc/graphite-test-results.git] / gcc / ada / a-stwisu.adb
blob2ffae8146827c7b122b124e920e899e2c1dd787a
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . W I D E _ S U P E R B O U N D E D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
33 with Ada.Strings.Wide_Search;
34
35 package body Ada.Strings.Wide_Superbounded is
36
37 ------------
38 -- Concat --
39 ------------
40
41 function Concat
42 (Left : Super_String;
43 Right : Super_String) return Super_String
44 is
45 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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_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_String
424
425 function Super_Append
426 (Left : Super_String;
427 Right : 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_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_String and Super_String
525
526 function Super_Append
527 (Left : 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_Character
579
580 function Super_Append
581 (Left : Super_String;
582 Right : 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_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_Character and Super_String
647
648 function Super_Append
649 (Left : 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_String;
689 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
690 return Natural
691 is
692 begin
693 return
694 Wide_Search.Count
695 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
696 end Super_Count;
697
698 function Super_Count
699 (Source : Super_String;
700 Pattern : Wide_String;
701 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
702 is
703 begin
704 return
705 Wide_Search.Count
706 (Source.Data (1 .. Source.Current_Length), Pattern, Mapping);
707 end Super_Count;
708
709 function Super_Count
710 (Source : Super_String;
711 Set : Wide_Maps.Wide_Character_Set) return Natural
712 is
713 begin
714 return Wide_Search.Count (Source.Data (1 .. Source.Current_Length), Set);
715 end Super_Count;
716
717 ------------------
718 -- Super_Delete --
719 ------------------
720
721 function Super_Delete
722 (Source : Super_String;
723 From : Positive;
724 Through : Natural) return Super_String
725 is
726 Result : Super_String (Source.Max_Length);
727 Slen : constant Natural := Source.Current_Length;
728 Num_Delete : constant Integer := Through - From + 1;
729
730 begin
731 if Num_Delete <= 0 then
732 return Source;
733
734 elsif From > Slen + 1 then
735 raise Ada.Strings.Index_Error;
736
737 elsif Through >= Slen then
738 Result.Current_Length := From - 1;
739 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
740 return Result;
741
742 else
743 Result.Current_Length := Slen - Num_Delete;
744 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
745 Result.Data (From .. Result.Current_Length) :=
746 Source.Data (Through + 1 .. Slen);
747 return Result;
748 end if;
749 end Super_Delete;
750
751 procedure Super_Delete
752 (Source : in out Super_String;
753 From : Positive;
754 Through : Natural)
755 is
756 Slen : constant Natural := Source.Current_Length;
757 Num_Delete : constant Integer := Through - From + 1;
758
759 begin
760 if Num_Delete <= 0 then
761 return;
762
763 elsif From > Slen + 1 then
764 raise Ada.Strings.Index_Error;
765
766 elsif Through >= Slen then
767 Source.Current_Length := From - 1;
768
769 else
770 Source.Current_Length := Slen - Num_Delete;
771 Source.Data (From .. Source.Current_Length) :=
772 Source.Data (Through + 1 .. Slen);
773 end if;
774 end Super_Delete;
775
776 -------------------
777 -- Super_Element --
778 -------------------
779
780 function Super_Element
781 (Source : Super_String;
782 Index : Positive) return Wide_Character
783 is
784 begin
785 if Index <= Source.Current_Length then
786 return Source.Data (Index);
787 else
788 raise Strings.Index_Error;
789 end if;
790 end Super_Element;
791
792 ----------------------
793 -- Super_Find_Token --
794 ----------------------
795
796 procedure Super_Find_Token
797 (Source : Super_String;
798 Set : Wide_Maps.Wide_Character_Set;
799 From : Positive;
800 Test : Strings.Membership;
801 First : out Positive;
802 Last : out Natural)
803 is
804 begin
805 Wide_Search.Find_Token
806 (Source.Data (From .. Source.Current_Length), Set, Test, First, Last);
807 end Super_Find_Token;
808
809 procedure Super_Find_Token
810 (Source : Super_String;
811 Set : Wide_Maps.Wide_Character_Set;
812 Test : Strings.Membership;
813 First : out Positive;
814 Last : out Natural)
815 is
816 begin
817 Wide_Search.Find_Token
818 (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last);
819 end Super_Find_Token;
820
821 ----------------
822 -- Super_Head --
823 ----------------
824
825 function Super_Head
826 (Source : Super_String;
827 Count : Natural;
828 Pad : Wide_Character := Wide_Space;
829 Drop : Strings.Truncation := Strings.Error) return Super_String
830 is
831 Max_Length : constant Positive := Source.Max_Length;
832 Result : Super_String (Max_Length);
833 Slen : constant Natural := Source.Current_Length;
834 Npad : constant Integer := Count - Slen;
835
836 begin
837 if Npad <= 0 then
838 Result.Current_Length := Count;
839 Result.Data (1 .. Count) := Source.Data (1 .. Count);
840
841 elsif Count <= Max_Length then
842 Result.Current_Length := Count;
843 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
844 Result.Data (Slen + 1 .. Count) := (others => Pad);
845
846 else
847 Result.Current_Length := Max_Length;
848
849 case Drop is
850 when Strings.Right =>
851 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
852 Result.Data (Slen + 1 .. Max_Length) := (others => Pad);
853
854 when Strings.Left =>
855 if Npad >= Max_Length then
856 Result.Data := (others => Pad);
857
858 else
859 Result.Data (1 .. Max_Length - Npad) :=
860 Source.Data (Count - Max_Length + 1 .. Slen);
861 Result.Data (Max_Length - Npad + 1 .. Max_Length) :=
862 (others => Pad);
863 end if;
864
865 when Strings.Error =>
866 raise Ada.Strings.Length_Error;
867 end case;
868 end if;
869
870 return Result;
871 end Super_Head;
872
873 procedure Super_Head
874 (Source : in out Super_String;
875 Count : Natural;
876 Pad : Wide_Character := Wide_Space;
877 Drop : Truncation := Error)
878 is
879 Max_Length : constant Positive := Source.Max_Length;
880 Slen : constant Natural := Source.Current_Length;
881 Npad : constant Integer := Count - Slen;
882 Temp : Wide_String (1 .. Max_Length);
883
884 begin
885 if Npad <= 0 then
886 Source.Current_Length := Count;
887
888 elsif Count <= Max_Length then
889 Source.Current_Length := Count;
890 Source.Data (Slen + 1 .. Count) := (others => Pad);
891
892 else
893 Source.Current_Length := Max_Length;
894
895 case Drop is
896 when Strings.Right =>
897 Source.Data (Slen + 1 .. Max_Length) := (others => Pad);
898
899 when Strings.Left =>
900 if Npad > Max_Length then
901 Source.Data := (others => Pad);
902
903 else
904 Temp := Source.Data;
905 Source.Data (1 .. Max_Length - Npad) :=
906 Temp (Count - Max_Length + 1 .. Slen);
907
908 for J in Max_Length - Npad + 1 .. Max_Length loop
909 Source.Data (J) := Pad;
910 end loop;
911 end if;
912
913 when Strings.Error =>
914 raise Ada.Strings.Length_Error;
915 end case;
916 end if;
917 end Super_Head;
918
919 -----------------
920 -- Super_Index --
921 -----------------
922
923 function Super_Index
924 (Source : Super_String;
925 Pattern : Wide_String;
926 Going : Strings.Direction := Strings.Forward;
927 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
928 return Natural
929 is
930 begin
931 return Wide_Search.Index
932 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
933 end Super_Index;
934
935 function Super_Index
936 (Source : Super_String;
937 Pattern : Wide_String;
938 Going : Direction := Forward;
939 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
940 is
941 begin
942 return Wide_Search.Index
943 (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping);
944 end Super_Index;
945
946 function Super_Index
947 (Source : Super_String;
948 Set : Wide_Maps.Wide_Character_Set;
949 Test : Strings.Membership := Strings.Inside;
950 Going : Strings.Direction := Strings.Forward) return Natural
951 is
952 begin
953 return Wide_Search.Index
954 (Source.Data (1 .. Source.Current_Length), Set, Test, Going);
955 end Super_Index;
956
957 function Super_Index
958 (Source : Super_String;
959 Pattern : Wide_String;
960 From : Positive;
961 Going : Direction := Forward;
962 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
963 return Natural
964 is
965 begin
966 return Wide_Search.Index
967 (Source.Data (1 .. Source.Current_Length),
968 Pattern, From, Going, Mapping);
969 end Super_Index;
970
971 function Super_Index
972 (Source : Super_String;
973 Pattern : Wide_String;
974 From : Positive;
975 Going : Direction := Forward;
976 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
977 is
978 begin
979 return Wide_Search.Index
980 (Source.Data (1 .. Source.Current_Length),
981 Pattern, From, Going, Mapping);
982 end Super_Index;
983
984 function Super_Index
985 (Source : Super_String;
986 Set : Wide_Maps.Wide_Character_Set;
987 From : Positive;
988 Test : Membership := Inside;
989 Going : Direction := Forward) return Natural
990 is
991 begin
992 return Wide_Search.Index
993 (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going);
994 end Super_Index;
995
996 ---------------------------
997 -- Super_Index_Non_Blank --
998 ---------------------------
999
1000 function Super_Index_Non_Blank
1001 (Source : Super_String;
1002 Going : Strings.Direction := Strings.Forward) return Natural
1003 is
1004 begin
1005 return
1006 Wide_Search.Index_Non_Blank
1007 (Source.Data (1 .. Source.Current_Length), Going);
1008 end Super_Index_Non_Blank;
1009
1010 function Super_Index_Non_Blank
1011 (Source : Super_String;
1012 From : Positive;
1013 Going : Direction := Forward) return Natural
1014 is
1015 begin
1016 return
1017 Wide_Search.Index_Non_Blank
1018 (Source.Data (1 .. Source.Current_Length), From, Going);
1019 end Super_Index_Non_Blank;
1020
1021 ------------------
1022 -- Super_Insert --
1023 ------------------
1024
1025 function Super_Insert
1026 (Source : Super_String;
1027 Before : Positive;
1028 New_Item : Wide_String;
1029 Drop : Strings.Truncation := Strings.Error) return Super_String
1030 is
1031 Max_Length : constant Positive := Source.Max_Length;
1032 Result : Super_String (Max_Length);
1033 Slen : constant Natural := Source.Current_Length;
1034 Nlen : constant Natural := New_Item'Length;
1035 Tlen : constant Natural := Slen + Nlen;
1036 Blen : constant Natural := Before - 1;
1037 Alen : constant Integer := Slen - Blen;
1038 Droplen : constant Integer := Tlen - Max_Length;
1039
1040 -- Tlen is the length of the total string before possible truncation.
1041 -- Blen, Alen are the lengths of the before and after pieces of the
1042 -- source string.
1043
1044 begin
1045 if Alen < 0 then
1046 raise Ada.Strings.Index_Error;
1047
1048 elsif Droplen <= 0 then
1049 Result.Current_Length := Tlen;
1050 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1051 Result.Data (Before .. Before + Nlen - 1) := New_Item;
1052 Result.Data (Before + Nlen .. Tlen) :=
1053 Source.Data (Before .. Slen);
1054
1055 else
1056 Result.Current_Length := Max_Length;
1057
1058 case Drop is
1059 when Strings.Right =>
1060 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1061
1062 if Droplen > Alen then
1063 Result.Data (Before .. Max_Length) :=
1064 New_Item (New_Item'First
1065 .. New_Item'First + Max_Length - Before);
1066 else
1067 Result.Data (Before .. Before + Nlen - 1) := New_Item;
1068 Result.Data (Before + Nlen .. Max_Length) :=
1069 Source.Data (Before .. Slen - Droplen);
1070 end if;
1071
1072 when Strings.Left =>
1073 Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1074 Source.Data (Before .. Slen);
1075
1076 if Droplen >= Blen then
1077 Result.Data (1 .. Max_Length - Alen) :=
1078 New_Item (New_Item'Last - (Max_Length - Alen) + 1
1079 .. New_Item'Last);
1080 else
1081 Result.Data
1082 (Blen - Droplen + 1 .. Max_Length - Alen) :=
1083 New_Item;
1084 Result.Data (1 .. Blen - Droplen) :=
1085 Source.Data (Droplen + 1 .. Blen);
1086 end if;
1087
1088 when Strings.Error =>
1089 raise Ada.Strings.Length_Error;
1090 end case;
1091 end if;
1092
1093 return Result;
1094 end Super_Insert;
1095
1096 procedure Super_Insert
1097 (Source : in out Super_String;
1098 Before : Positive;
1099 New_Item : Wide_String;
1100 Drop : Strings.Truncation := Strings.Error)
1101 is
1102 begin
1103 -- We do a double copy here because this is one of the situations
1104 -- in which we move data to the right, and at least at the moment,
1105 -- GNAT is not handling such cases correctly ???
1106
1107 Source := Super_Insert (Source, Before, New_Item, Drop);
1108 end Super_Insert;
1109
1110 ------------------
1111 -- Super_Length --
1112 ------------------
1113
1114 function Super_Length (Source : Super_String) return Natural is
1115 begin
1116 return Source.Current_Length;
1117 end Super_Length;
1118
1119 ---------------------
1120 -- Super_Overwrite --
1121 ---------------------
1122
1123 function Super_Overwrite
1124 (Source : Super_String;
1125 Position : Positive;
1126 New_Item : Wide_String;
1127 Drop : Strings.Truncation := Strings.Error) return Super_String
1128 is
1129 Max_Length : constant Positive := Source.Max_Length;
1130 Result : Super_String (Max_Length);
1131 Endpos : constant Natural := Position + New_Item'Length - 1;
1132 Slen : constant Natural := Source.Current_Length;
1133 Droplen : Natural;
1134
1135 begin
1136 if Position > Slen + 1 then
1137 raise Ada.Strings.Index_Error;
1138
1139 elsif New_Item'Length = 0 then
1140 return Source;
1141
1142 elsif Endpos <= Slen then
1143 Result.Current_Length := Source.Current_Length;
1144 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
1145 Result.Data (Position .. Endpos) := New_Item;
1146 return Result;
1147
1148 elsif Endpos <= Max_Length then
1149 Result.Current_Length := Endpos;
1150 Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1);
1151 Result.Data (Position .. Endpos) := New_Item;
1152 return Result;
1153
1154 else
1155 Result.Current_Length := Max_Length;
1156 Droplen := Endpos - Max_Length;
1157
1158 case Drop is
1159 when Strings.Right =>
1160 Result.Data (1 .. Position - 1) :=
1161 Source.Data (1 .. Position - 1);
1162
1163 Result.Data (Position .. Max_Length) :=
1164 New_Item (New_Item'First .. New_Item'Last - Droplen);
1165 return Result;
1166
1167 when Strings.Left =>
1168 if New_Item'Length >= Max_Length then
1169 Result.Data (1 .. Max_Length) :=
1170 New_Item (New_Item'Last - Max_Length + 1 ..
1171 New_Item'Last);
1172 return Result;
1173
1174 else
1175 Result.Data (1 .. Max_Length - New_Item'Length) :=
1176 Source.Data (Droplen + 1 .. Position - 1);
1177 Result.Data
1178 (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1179 New_Item;
1180 return Result;
1181 end if;
1182
1183 when Strings.Error =>
1184 raise Ada.Strings.Length_Error;
1185 end case;
1186 end if;
1187 end Super_Overwrite;
1188
1189 procedure Super_Overwrite
1190 (Source : in out Super_String;
1191 Position : Positive;
1192 New_Item : Wide_String;
1193 Drop : Strings.Truncation := Strings.Error)
1194 is
1195 Max_Length : constant Positive := Source.Max_Length;
1196 Endpos : constant Positive := Position + New_Item'Length - 1;
1197 Slen : constant Natural := Source.Current_Length;
1198 Droplen : Natural;
1199
1200 begin
1201 if Position > Slen + 1 then
1202 raise Ada.Strings.Index_Error;
1203
1204 elsif Endpos <= Slen then
1205 Source.Data (Position .. Endpos) := New_Item;
1206
1207 elsif Endpos <= Max_Length then
1208 Source.Data (Position .. Endpos) := New_Item;
1209 Source.Current_Length := Endpos;
1210
1211 else
1212 Source.Current_Length := Max_Length;
1213 Droplen := Endpos - Max_Length;
1214
1215 case Drop is
1216 when Strings.Right =>
1217 Source.Data (Position .. Max_Length) :=
1218 New_Item (New_Item'First .. New_Item'Last - Droplen);
1219
1220 when Strings.Left =>
1221 if New_Item'Length > Max_Length then
1222 Source.Data (1 .. Max_Length) :=
1223 New_Item (New_Item'Last - Max_Length + 1 ..
1224 New_Item'Last);
1225
1226 else
1227 Source.Data (1 .. Max_Length - New_Item'Length) :=
1228 Source.Data (Droplen + 1 .. Position - 1);
1229
1230 Source.Data
1231 (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1232 New_Item;
1233 end if;
1234
1235 when Strings.Error =>
1236 raise Ada.Strings.Length_Error;
1237 end case;
1238 end if;
1239 end Super_Overwrite;
1240
1241 ---------------------------
1242 -- Super_Replace_Element --
1243 ---------------------------
1244
1245 procedure Super_Replace_Element
1246 (Source : in out Super_String;
1247 Index : Positive;
1248 By : Wide_Character)
1249 is
1250 begin
1251 if Index <= Source.Current_Length then
1252 Source.Data (Index) := By;
1253 else
1254 raise Ada.Strings.Index_Error;
1255 end if;
1256 end Super_Replace_Element;
1257
1258 -------------------------
1259 -- Super_Replace_Slice --
1260 -------------------------
1261
1262 function Super_Replace_Slice
1263 (Source : Super_String;
1264 Low : Positive;
1265 High : Natural;
1266 By : Wide_String;
1267 Drop : Strings.Truncation := Strings.Error) return Super_String
1268 is
1269 Max_Length : constant Positive := Source.Max_Length;
1270 Slen : constant Natural := Source.Current_Length;
1271
1272 begin
1273 if Low > Slen + 1 then
1274 raise Strings.Index_Error;
1275
1276 elsif High < Low then
1277 return Super_Insert (Source, Low, By, Drop);
1278
1279 else
1280 declare
1281 Blen : constant Natural := Natural'Max (0, Low - 1);
1282 Alen : constant Natural := Natural'Max (0, Slen - High);
1283 Tlen : constant Natural := Blen + By'Length + Alen;
1284 Droplen : constant Integer := Tlen - Max_Length;
1285 Result : Super_String (Max_Length);
1286
1287 -- Tlen is the total length of the result string before any
1288 -- truncation. Blen and Alen are the lengths of the pieces
1289 -- of the original string that end up in the result string
1290 -- before and after the replaced slice.
1291
1292 begin
1293 if Droplen <= 0 then
1294 Result.Current_Length := Tlen;
1295 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1296 Result.Data (Low .. Low + By'Length - 1) := By;
1297 Result.Data (Low + By'Length .. Tlen) :=
1298 Source.Data (High + 1 .. Slen);
1299
1300 else
1301 Result.Current_Length := Max_Length;
1302
1303 case Drop is
1304 when Strings.Right =>
1305 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1306
1307 if Droplen > Alen then
1308 Result.Data (Low .. Max_Length) :=
1309 By (By'First .. By'First + Max_Length - Low);
1310 else
1311 Result.Data (Low .. Low + By'Length - 1) := By;
1312 Result.Data (Low + By'Length .. Max_Length) :=
1313 Source.Data (High + 1 .. Slen - Droplen);
1314 end if;
1315
1316 when Strings.Left =>
1317 Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1318 Source.Data (High + 1 .. Slen);
1319
1320 if Droplen >= Blen then
1321 Result.Data (1 .. Max_Length - Alen) :=
1322 By (By'Last - (Max_Length - Alen) + 1 .. By'Last);
1323 else
1324 Result.Data
1325 (Blen - Droplen + 1 .. Max_Length - Alen) := By;
1326 Result.Data (1 .. Blen - Droplen) :=
1327 Source.Data (Droplen + 1 .. Blen);
1328 end if;
1329
1330 when Strings.Error =>
1331 raise Ada.Strings.Length_Error;
1332 end case;
1333 end if;
1334
1335 return Result;
1336 end;
1337 end if;
1338 end Super_Replace_Slice;
1339
1340 procedure Super_Replace_Slice
1341 (Source : in out Super_String;
1342 Low : Positive;
1343 High : Natural;
1344 By : Wide_String;
1345 Drop : Strings.Truncation := Strings.Error)
1346 is
1347 begin
1348 -- We do a double copy here because this is one of the situations
1349 -- in which we move data to the right, and at least at the moment,
1350 -- GNAT is not handling such cases correctly ???
1351
1352 Source := Super_Replace_Slice (Source, Low, High, By, Drop);
1353 end Super_Replace_Slice;
1354
1355 ---------------------
1356 -- Super_Replicate --
1357 ---------------------
1358
1359 function Super_Replicate
1360 (Count : Natural;
1361 Item : Wide_Character;
1362 Drop : Truncation := Error;
1363 Max_Length : Positive) return Super_String
1364 is
1365 Result : Super_String (Max_Length);
1366
1367 begin
1368 if Count <= Max_Length then
1369 Result.Current_Length := Count;
1370
1371 elsif Drop = Strings.Error then
1372 raise Ada.Strings.Length_Error;
1373
1374 else
1375 Result.Current_Length := Max_Length;
1376 end if;
1377
1378 Result.Data (1 .. Result.Current_Length) := (others => Item);
1379 return Result;
1380 end Super_Replicate;
1381
1382 function Super_Replicate
1383 (Count : Natural;
1384 Item : Wide_String;
1385 Drop : Truncation := Error;
1386 Max_Length : Positive) return Super_String
1387 is
1388 Length : constant Integer := Count * Item'Length;
1389 Result : Super_String (Max_Length);
1390 Indx : Positive;
1391
1392 begin
1393 if Length <= Max_Length then
1394 Result.Current_Length := Length;
1395
1396 if Length > 0 then
1397 Indx := 1;
1398
1399 for J in 1 .. Count loop
1400 Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1401 Indx := Indx + Item'Length;
1402 end loop;
1403 end if;
1404
1405 else
1406 Result.Current_Length := Max_Length;
1407
1408 case Drop is
1409 when Strings.Right =>
1410 Indx := 1;
1411
1412 while Indx + Item'Length <= Max_Length + 1 loop
1413 Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1414 Indx := Indx + Item'Length;
1415 end loop;
1416
1417 Result.Data (Indx .. Max_Length) :=
1418 Item (Item'First .. Item'First + Max_Length - Indx);
1419
1420 when Strings.Left =>
1421 Indx := Max_Length;
1422
1423 while Indx - Item'Length >= 1 loop
1424 Result.Data (Indx - (Item'Length - 1) .. Indx) := Item;
1425 Indx := Indx - Item'Length;
1426 end loop;
1427
1428 Result.Data (1 .. Indx) :=
1429 Item (Item'Last - Indx + 1 .. Item'Last);
1430
1431 when Strings.Error =>
1432 raise Ada.Strings.Length_Error;
1433 end case;
1434 end if;
1435
1436 return Result;
1437 end Super_Replicate;
1438
1439 function Super_Replicate
1440 (Count : Natural;
1441 Item : Super_String;
1442 Drop : Strings.Truncation := Strings.Error) return Super_String
1443 is
1444 begin
1445 return
1446 Super_Replicate
1447 (Count,
1448 Item.Data (1 .. Item.Current_Length),
1449 Drop,
1450 Item.Max_Length);
1451 end Super_Replicate;
1452
1453 -----------------
1454 -- Super_Slice --
1455 -----------------
1456
1457 function Super_Slice
1458 (Source : Super_String;
1459 Low : Positive;
1460 High : Natural) return Wide_String
1461 is
1462 begin
1463 -- Note: test of High > Length is in accordance with AI95-00128
1464
1465 if Low > Source.Current_Length + 1
1466 or else High > Source.Current_Length
1467 then
1468 raise Index_Error;
1469 else
1470 return Source.Data (Low .. High);
1471 end if;
1472 end Super_Slice;
1473
1474 function Super_Slice
1475 (Source : Super_String;
1476 Low : Positive;
1477 High : Natural) return Super_String
1478 is
1479 Result : Super_String (Source.Max_Length);
1480
1481 begin
1482 if Low > Source.Current_Length + 1
1483 or else High > Source.Current_Length
1484 then
1485 raise Index_Error;
1486 else
1487 Result.Current_Length := High - Low + 1;
1488 Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
1489 end if;
1490
1491 return Result;
1492 end Super_Slice;
1493
1494 procedure Super_Slice
1495 (Source : Super_String;
1496 Target : out Super_String;
1497 Low : Positive;
1498 High : Natural)
1499 is
1500 begin
1501 if Low > Source.Current_Length + 1
1502 or else High > Source.Current_Length
1503 then
1504 raise Index_Error;
1505 else
1506 Target.Current_Length := High - Low + 1;
1507 Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High);
1508 end if;
1509 end Super_Slice;
1510
1511 ----------------
1512 -- Super_Tail --
1513 ----------------
1514
1515 function Super_Tail
1516 (Source : Super_String;
1517 Count : Natural;
1518 Pad : Wide_Character := Wide_Space;
1519 Drop : Strings.Truncation := Strings.Error) return Super_String
1520 is
1521 Max_Length : constant Positive := Source.Max_Length;
1522 Result : Super_String (Max_Length);
1523 Slen : constant Natural := Source.Current_Length;
1524 Npad : constant Integer := Count - Slen;
1525
1526 begin
1527 if Npad <= 0 then
1528 Result.Current_Length := Count;
1529 Result.Data (1 .. Count) :=
1530 Source.Data (Slen - (Count - 1) .. Slen);
1531
1532 elsif Count <= Max_Length then
1533 Result.Current_Length := Count;
1534 Result.Data (1 .. Npad) := (others => Pad);
1535 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1536
1537 else
1538 Result.Current_Length := Max_Length;
1539
1540 case Drop is
1541 when Strings.Right =>
1542 if Npad >= Max_Length then
1543 Result.Data := (others => Pad);
1544
1545 else
1546 Result.Data (1 .. Npad) := (others => Pad);
1547 Result.Data (Npad + 1 .. Max_Length) :=
1548 Source.Data (1 .. Max_Length - Npad);
1549 end if;
1550
1551 when Strings.Left =>
1552 Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1553 Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1554 Source.Data (1 .. Slen);
1555
1556 when Strings.Error =>
1557 raise Ada.Strings.Length_Error;
1558 end case;
1559 end if;
1560
1561 return Result;
1562 end Super_Tail;
1563
1564 procedure Super_Tail
1565 (Source : in out Super_String;
1566 Count : Natural;
1567 Pad : Wide_Character := Wide_Space;
1568 Drop : Truncation := Error)
1569 is
1570 Max_Length : constant Positive := Source.Max_Length;
1571 Slen : constant Natural := Source.Current_Length;
1572 Npad : constant Integer := Count - Slen;
1573
1574 Temp : constant Wide_String (1 .. Max_Length) := Source.Data;
1575
1576 begin
1577 if Npad <= 0 then
1578 Source.Current_Length := Count;
1579 Source.Data (1 .. Count) :=
1580 Temp (Slen - (Count - 1) .. Slen);
1581
1582 elsif Count <= Max_Length then
1583 Source.Current_Length := Count;
1584 Source.Data (1 .. Npad) := (others => Pad);
1585 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1586
1587 else
1588 Source.Current_Length := Max_Length;
1589
1590 case Drop is
1591 when Strings.Right =>
1592 if Npad >= Max_Length then
1593 Source.Data := (others => Pad);
1594
1595 else
1596 Source.Data (1 .. Npad) := (others => Pad);
1597 Source.Data (Npad + 1 .. Max_Length) :=
1598 Temp (1 .. Max_Length - Npad);
1599 end if;
1600
1601 when Strings.Left =>
1602 for J in 1 .. Max_Length - Slen loop
1603 Source.Data (J) := Pad;
1604 end loop;
1605
1606 Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1607 Temp (1 .. Slen);
1608
1609 when Strings.Error =>
1610 raise Ada.Strings.Length_Error;
1611 end case;
1612 end if;
1613 end Super_Tail;
1614
1615 ---------------------
1616 -- Super_To_String --
1617 ---------------------
1618
1619 function Super_To_String (Source : Super_String) return Wide_String is
1620 begin
1621 return Source.Data (1 .. Source.Current_Length);
1622 end Super_To_String;
1623
1624 ---------------------
1625 -- Super_Translate --
1626 ---------------------
1627
1628 function Super_Translate
1629 (Source : Super_String;
1630 Mapping : Wide_Maps.Wide_Character_Mapping) return Super_String
1631 is
1632 Result : Super_String (Source.Max_Length);
1633
1634 begin
1635 Result.Current_Length := Source.Current_Length;
1636
1637 for J in 1 .. Source.Current_Length loop
1638 Result.Data (J) := Value (Mapping, Source.Data (J));
1639 end loop;
1640
1641 return Result;
1642 end Super_Translate;
1643
1644 procedure Super_Translate
1645 (Source : in out Super_String;
1646 Mapping : Wide_Maps.Wide_Character_Mapping)
1647 is
1648 begin
1649 for J in 1 .. Source.Current_Length loop
1650 Source.Data (J) := Value (Mapping, Source.Data (J));
1651 end loop;
1652 end Super_Translate;
1653
1654 function Super_Translate
1655 (Source : Super_String;
1656 Mapping : Wide_Maps.Wide_Character_Mapping_Function) 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_Maps.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_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_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_Maps.Wide_Character_Set;
1742 Right : Wide_Maps.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_Maps.Wide_Character_Set;
1767 Right : Wide_Maps.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_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_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_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_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_Superbounded;
GCC graphite test results