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