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