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