1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                 A D A . S T R I N G S . U N B O U N D E D                --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2018, 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.Fixed;
33with Ada.Strings.Search;
34with Ada.Unchecked_Deallocation;
35
36package body Ada.Strings.Unbounded is
37
38   ---------
39   -- "&" --
40   ---------
41
42   function "&"
43     (Left  : Unbounded_String;
44      Right : Unbounded_String) return Unbounded_String
45   is
46      L_Length : constant Natural := Left.Last;
47      R_Length : constant Natural := Right.Last;
48      Result   : Unbounded_String;
49
50   begin
51      Result.Last := L_Length + R_Length;
52
53      Result.Reference := new String (1 .. Result.Last);
54
55      Result.Reference (1 .. L_Length) :=
56        Left.Reference (1 .. Left.Last);
57      Result.Reference (L_Length + 1 .. Result.Last) :=
58        Right.Reference (1 .. Right.Last);
59
60      return Result;
61   end "&";
62
63   function "&"
64     (Left  : Unbounded_String;
65      Right : String) return Unbounded_String
66   is
67      L_Length : constant Natural := Left.Last;
68      Result   : Unbounded_String;
69
70   begin
71      Result.Last := L_Length + Right'Length;
72
73      Result.Reference := new String (1 .. Result.Last);
74
75      Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
76      Result.Reference (L_Length + 1 .. Result.Last) := Right;
77
78      return Result;
79   end "&";
80
81   function "&"
82     (Left  : String;
83      Right : Unbounded_String) return Unbounded_String
84   is
85      R_Length : constant Natural := Right.Last;
86      Result   : Unbounded_String;
87
88   begin
89      Result.Last := Left'Length + R_Length;
90
91      Result.Reference := new String (1 .. Result.Last);
92
93      Result.Reference (1 .. Left'Length) := Left;
94      Result.Reference (Left'Length + 1 .. Result.Last) :=
95        Right.Reference (1 .. Right.Last);
96
97      return Result;
98   end "&";
99
100   function "&"
101     (Left  : Unbounded_String;
102      Right : Character) return Unbounded_String
103   is
104      Result : Unbounded_String;
105
106   begin
107      Result.Last := Left.Last + 1;
108
109      Result.Reference := new String (1 .. Result.Last);
110
111      Result.Reference (1 .. Result.Last - 1) :=
112        Left.Reference (1 .. Left.Last);
113      Result.Reference (Result.Last) := Right;
114
115      return Result;
116   end "&";
117
118   function "&"
119     (Left  : Character;
120      Right : Unbounded_String) return Unbounded_String
121   is
122      Result : Unbounded_String;
123
124   begin
125      Result.Last := Right.Last + 1;
126
127      Result.Reference := new String (1 .. Result.Last);
128      Result.Reference (1) := Left;
129      Result.Reference (2 .. Result.Last) :=
130        Right.Reference (1 .. Right.Last);
131      return Result;
132   end "&";
133
134   ---------
135   -- "*" --
136   ---------
137
138   function "*"
139     (Left  : Natural;
140      Right : Character) return Unbounded_String
141   is
142      Result : Unbounded_String;
143
144   begin
145      Result.Last   := Left;
146
147      Result.Reference := new String (1 .. Left);
148      for J in Result.Reference'Range loop
149         Result.Reference (J) := Right;
150      end loop;
151
152      return Result;
153   end "*";
154
155   function "*"
156     (Left  : Natural;
157      Right : String) return Unbounded_String
158   is
159      Len    : constant Natural := Right'Length;
160      K      : Positive;
161      Result : Unbounded_String;
162
163   begin
164      Result.Last := Left * Len;
165
166      Result.Reference := new String (1 .. Result.Last);
167
168      K := 1;
169      for J in 1 .. Left loop
170         Result.Reference (K .. K + Len - 1) := Right;
171         K := K + Len;
172      end loop;
173
174      return Result;
175   end "*";
176
177   function "*"
178     (Left  : Natural;
179      Right : Unbounded_String) return Unbounded_String
180   is
181      Len    : constant Natural := Right.Last;
182      K      : Positive;
183      Result : Unbounded_String;
184
185   begin
186      Result.Last := Left * Len;
187
188      Result.Reference := new String (1 .. Result.Last);
189
190      K := 1;
191      for J in 1 .. Left loop
192         Result.Reference (K .. K + Len - 1) :=
193           Right.Reference (1 .. Right.Last);
194         K := K + Len;
195      end loop;
196
197      return Result;
198   end "*";
199
200   ---------
201   -- "<" --
202   ---------
203
204   function "<"
205     (Left  : Unbounded_String;
206      Right : Unbounded_String) return Boolean
207   is
208   begin
209      return
210        Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
211   end "<";
212
213   function "<"
214     (Left  : Unbounded_String;
215      Right : String) return Boolean
216   is
217   begin
218      return Left.Reference (1 .. Left.Last) < Right;
219   end "<";
220
221   function "<"
222     (Left  : String;
223      Right : Unbounded_String) return Boolean
224   is
225   begin
226      return Left < Right.Reference (1 .. Right.Last);
227   end "<";
228
229   ----------
230   -- "<=" --
231   ----------
232
233   function "<="
234     (Left  : Unbounded_String;
235      Right : Unbounded_String) return Boolean
236   is
237   begin
238      return
239        Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
240   end "<=";
241
242   function "<="
243     (Left  : Unbounded_String;
244      Right : String) return Boolean
245   is
246   begin
247      return Left.Reference (1 .. Left.Last) <= Right;
248   end "<=";
249
250   function "<="
251     (Left  : String;
252      Right : Unbounded_String) return Boolean
253   is
254   begin
255      return Left <= Right.Reference (1 .. Right.Last);
256   end "<=";
257
258   ---------
259   -- "=" --
260   ---------
261
262   function "="
263     (Left  : Unbounded_String;
264      Right : Unbounded_String) return Boolean
265   is
266   begin
267      return
268        Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
269   end "=";
270
271   function "="
272     (Left  : Unbounded_String;
273      Right : String) return Boolean
274   is
275   begin
276      return Left.Reference (1 .. Left.Last) = Right;
277   end "=";
278
279   function "="
280     (Left  : String;
281      Right : Unbounded_String) return Boolean
282   is
283   begin
284      return Left = Right.Reference (1 .. Right.Last);
285   end "=";
286
287   ---------
288   -- ">" --
289   ---------
290
291   function ">"
292     (Left  : Unbounded_String;
293      Right : Unbounded_String) return Boolean
294   is
295   begin
296      return
297        Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
298   end ">";
299
300   function ">"
301     (Left  : Unbounded_String;
302      Right : String) return Boolean
303   is
304   begin
305      return Left.Reference (1 .. Left.Last) > Right;
306   end ">";
307
308   function ">"
309     (Left  : String;
310      Right : Unbounded_String) return Boolean
311   is
312   begin
313      return Left > Right.Reference (1 .. Right.Last);
314   end ">";
315
316   ----------
317   -- ">=" --
318   ----------
319
320   function ">="
321     (Left  : Unbounded_String;
322      Right : Unbounded_String) return Boolean
323   is
324   begin
325      return
326        Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
327   end ">=";
328
329   function ">="
330     (Left  : Unbounded_String;
331      Right : String) return Boolean
332   is
333   begin
334      return Left.Reference (1 .. Left.Last) >= Right;
335   end ">=";
336
337   function ">="
338     (Left  : String;
339      Right : Unbounded_String) return Boolean
340   is
341   begin
342      return Left >= Right.Reference (1 .. Right.Last);
343   end ">=";
344
345   ------------
346   -- Adjust --
347   ------------
348
349   procedure Adjust (Object : in out Unbounded_String) is
350   begin
351      --  Copy string, except we do not copy the statically allocated null
352      --  string since it can never be deallocated. Note that we do not copy
353      --  extra string room here to avoid dragging unused allocated memory.
354
355      if Object.Reference /= Null_String'Access then
356         Object.Reference := new String'(Object.Reference (1 .. Object.Last));
357      end if;
358   end Adjust;
359
360   ------------
361   -- Append --
362   ------------
363
364   procedure Append
365     (Source   : in out Unbounded_String;
366      New_Item : Unbounded_String)
367   is
368   begin
369      Realloc_For_Chunk (Source, New_Item.Last);
370      Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
371        New_Item.Reference (1 .. New_Item.Last);
372      Source.Last := Source.Last + New_Item.Last;
373   end Append;
374
375   procedure Append
376     (Source   : in out Unbounded_String;
377      New_Item : String)
378   is
379   begin
380      Realloc_For_Chunk (Source, New_Item'Length);
381      Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
382        New_Item;
383      Source.Last := Source.Last + New_Item'Length;
384   end Append;
385
386   procedure Append
387     (Source   : in out Unbounded_String;
388      New_Item : Character)
389   is
390   begin
391      Realloc_For_Chunk (Source, 1);
392      Source.Reference (Source.Last + 1) := New_Item;
393      Source.Last := Source.Last + 1;
394   end Append;
395
396   -----------
397   -- Count --
398   -----------
399
400   function Count
401     (Source  : Unbounded_String;
402      Pattern : String;
403      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
404   is
405   begin
406      return
407        Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
408   end Count;
409
410   function Count
411     (Source  : Unbounded_String;
412      Pattern : String;
413      Mapping : Maps.Character_Mapping_Function) return Natural
414   is
415   begin
416      return
417        Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
418   end Count;
419
420   function Count
421     (Source : Unbounded_String;
422      Set    : Maps.Character_Set) return Natural
423   is
424   begin
425      return Search.Count (Source.Reference (1 .. Source.Last), Set);
426   end Count;
427
428   ------------
429   -- Delete --
430   ------------
431
432   function Delete
433     (Source  : Unbounded_String;
434      From    : Positive;
435      Through : Natural) return Unbounded_String
436   is
437   begin
438      return
439        To_Unbounded_String
440          (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
441   end Delete;
442
443   procedure Delete
444     (Source  : in out Unbounded_String;
445      From    : Positive;
446      Through : Natural)
447   is
448   begin
449      if From > Through then
450         null;
451
452      elsif From < Source.Reference'First or else Through > Source.Last then
453         raise Index_Error;
454
455      else
456         declare
457            Len : constant Natural := Through - From + 1;
458
459         begin
460            Source.Reference (From .. Source.Last - Len) :=
461              Source.Reference (Through + 1 .. Source.Last);
462            Source.Last := Source.Last - Len;
463         end;
464      end if;
465   end Delete;
466
467   -------------
468   -- Element --
469   -------------
470
471   function Element
472     (Source : Unbounded_String;
473      Index  : Positive) return Character
474   is
475   begin
476      if Index <= Source.Last then
477         return Source.Reference (Index);
478      else
479         raise Strings.Index_Error;
480      end if;
481   end Element;
482
483   --------------
484   -- Finalize --
485   --------------
486
487   procedure Finalize (Object : in out Unbounded_String) is
488      procedure Deallocate is
489         new Ada.Unchecked_Deallocation (String, String_Access);
490
491   begin
492      --  Note: Don't try to free statically allocated null string
493
494      if Object.Reference /= Null_String'Access then
495         Deallocate (Object.Reference);
496         Object.Reference := Null_Unbounded_String.Reference;
497         Object.Last := 0;
498      end if;
499   end Finalize;
500
501   ----------------
502   -- Find_Token --
503   ----------------
504
505   procedure Find_Token
506     (Source : Unbounded_String;
507      Set    : Maps.Character_Set;
508      From   : Positive;
509      Test   : Strings.Membership;
510      First  : out Positive;
511      Last   : out Natural)
512   is
513   begin
514      Search.Find_Token
515        (Source.Reference (From .. Source.Last), Set, Test, First, Last);
516   end Find_Token;
517
518   procedure Find_Token
519     (Source : Unbounded_String;
520      Set    : Maps.Character_Set;
521      Test   : Strings.Membership;
522      First  : out Positive;
523      Last   : out Natural)
524   is
525   begin
526      Search.Find_Token
527        (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
528   end Find_Token;
529
530   ----------
531   -- Free --
532   ----------
533
534   procedure Free (X : in out String_Access) is
535      procedure Deallocate is
536         new Ada.Unchecked_Deallocation (String, String_Access);
537
538   begin
539      --  Note: Do not try to free statically allocated null string
540
541      if X /= Null_Unbounded_String.Reference then
542         Deallocate (X);
543      end if;
544   end Free;
545
546   ----------
547   -- Head --
548   ----------
549
550   function Head
551     (Source : Unbounded_String;
552      Count  : Natural;
553      Pad    : Character := Space) return Unbounded_String
554   is
555   begin
556      return To_Unbounded_String
557        (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
558   end Head;
559
560   procedure Head
561     (Source : in out Unbounded_String;
562      Count  : Natural;
563      Pad    : Character := Space)
564   is
565      Old : String_Access := Source.Reference;
566   begin
567      Source.Reference :=
568        new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
569                    Count, Pad));
570      Source.Last := Source.Reference'Length;
571      Free (Old);
572   end Head;
573
574   -----------
575   -- Index --
576   -----------
577
578   function Index
579     (Source  : Unbounded_String;
580      Pattern : String;
581      Going   : Strings.Direction := Strings.Forward;
582      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
583   is
584   begin
585      return Search.Index
586        (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
587   end Index;
588
589   function Index
590     (Source  : Unbounded_String;
591      Pattern : String;
592      Going   : Direction := Forward;
593      Mapping : Maps.Character_Mapping_Function) return Natural
594   is
595   begin
596      return Search.Index
597        (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
598   end Index;
599
600   function Index
601     (Source : Unbounded_String;
602      Set    : Maps.Character_Set;
603      Test   : Strings.Membership := Strings.Inside;
604      Going  : Strings.Direction  := Strings.Forward) return Natural
605   is
606   begin
607      return Search.Index
608        (Source.Reference (1 .. Source.Last), Set, Test, Going);
609   end Index;
610
611   function Index
612     (Source  : Unbounded_String;
613      Pattern : String;
614      From    : Positive;
615      Going   : Direction := Forward;
616      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
617   is
618   begin
619      return Search.Index
620        (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
621   end Index;
622
623   function Index
624     (Source  : Unbounded_String;
625      Pattern : String;
626      From    : Positive;
627      Going   : Direction := Forward;
628      Mapping : Maps.Character_Mapping_Function) return Natural
629   is
630   begin
631      return Search.Index
632        (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
633   end Index;
634
635   function Index
636     (Source  : Unbounded_String;
637      Set     : Maps.Character_Set;
638      From    : Positive;
639      Test    : Membership := Inside;
640      Going   : Direction := Forward) return Natural
641   is
642   begin
643      return Search.Index
644        (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
645   end Index;
646
647   function Index_Non_Blank
648     (Source : Unbounded_String;
649      Going  : Strings.Direction := Strings.Forward) return Natural
650   is
651   begin
652      return
653        Search.Index_Non_Blank
654          (Source.Reference (1 .. Source.Last), Going);
655   end Index_Non_Blank;
656
657   function Index_Non_Blank
658     (Source : Unbounded_String;
659      From   : Positive;
660      Going  : Direction := Forward) return Natural
661   is
662   begin
663      return
664        Search.Index_Non_Blank
665          (Source.Reference (1 .. Source.Last), From, Going);
666   end Index_Non_Blank;
667
668   ----------------
669   -- Initialize --
670   ----------------
671
672   procedure Initialize (Object : in out Unbounded_String) is
673   begin
674      Object.Reference := Null_Unbounded_String.Reference;
675      Object.Last      := 0;
676   end Initialize;
677
678   ------------
679   -- Insert --
680   ------------
681
682   function Insert
683     (Source   : Unbounded_String;
684      Before   : Positive;
685      New_Item : String) return Unbounded_String
686   is
687   begin
688      return To_Unbounded_String
689        (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
690   end Insert;
691
692   procedure Insert
693     (Source   : in out Unbounded_String;
694      Before   : Positive;
695      New_Item : String)
696   is
697   begin
698      if Before not in Source.Reference'First .. Source.Last + 1 then
699         raise Index_Error;
700      end if;
701
702      Realloc_For_Chunk (Source, New_Item'Length);
703
704      Source.Reference
705        (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
706           Source.Reference (Before .. Source.Last);
707
708      Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
709      Source.Last := Source.Last + New_Item'Length;
710   end Insert;
711
712   ------------
713   -- Length --
714   ------------
715
716   function Length (Source : Unbounded_String) return Natural is
717   begin
718      return Source.Last;
719   end Length;
720
721   ---------------
722   -- Overwrite --
723   ---------------
724
725   function Overwrite
726     (Source   : Unbounded_String;
727      Position : Positive;
728      New_Item : String) return Unbounded_String
729   is
730   begin
731      return To_Unbounded_String
732        (Fixed.Overwrite
733          (Source.Reference (1 .. Source.Last), Position, New_Item));
734   end Overwrite;
735
736   procedure Overwrite
737     (Source    : in out Unbounded_String;
738      Position  : Positive;
739      New_Item  : String)
740   is
741      NL : constant Natural := New_Item'Length;
742   begin
743      if Position <= Source.Last - NL + 1 then
744         Source.Reference (Position .. Position + NL - 1) := New_Item;
745      else
746         declare
747            Old : String_Access := Source.Reference;
748         begin
749            Source.Reference := new String'
750              (Fixed.Overwrite
751                (Source.Reference (1 .. Source.Last), Position, New_Item));
752            Source.Last := Source.Reference'Length;
753            Free (Old);
754         end;
755      end if;
756   end Overwrite;
757
758   -----------------------
759   -- Realloc_For_Chunk --
760   -----------------------
761
762   procedure Realloc_For_Chunk
763     (Source     : in out Unbounded_String;
764      Chunk_Size : Natural)
765   is
766      Growth_Factor : constant := 32;
767      --  The growth factor controls how much extra space is allocated when
768      --  we have to increase the size of an allocated unbounded string. By
769      --  allocating extra space, we avoid the need to reallocate on every
770      --  append, particularly important when a string is built up by repeated
771      --  append operations of small pieces. This is expressed as a factor so
772      --  32 means add 1/32 of the length of the string as growth space.
773
774      Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
775      --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
776      --  no memory loss as most (all?) malloc implementations are obliged to
777      --  align the returned memory on the maximum alignment as malloc does not
778      --  know the target alignment.
779
780      S_Length : constant Natural := Source.Reference'Length;
781
782   begin
783      if Chunk_Size > S_Length - Source.Last then
784         declare
785            New_Size : constant Positive :=
786              S_Length + Chunk_Size + (S_Length / Growth_Factor);
787
788            New_Rounded_Up_Size : constant Positive :=
789              ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
790
791            Tmp : constant String_Access :=
792              new String (1 .. New_Rounded_Up_Size);
793
794         begin
795            Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
796            Free (Source.Reference);
797            Source.Reference := Tmp;
798         end;
799      end if;
800   end Realloc_For_Chunk;
801
802   ---------------------
803   -- Replace_Element --
804   ---------------------
805
806   procedure Replace_Element
807     (Source : in out Unbounded_String;
808      Index  : Positive;
809      By     : Character)
810   is
811   begin
812      if Index <= Source.Last then
813         Source.Reference (Index) := By;
814      else
815         raise Strings.Index_Error;
816      end if;
817   end Replace_Element;
818
819   -------------------
820   -- Replace_Slice --
821   -------------------
822
823   function Replace_Slice
824     (Source : Unbounded_String;
825      Low    : Positive;
826      High   : Natural;
827      By     : String) return Unbounded_String
828   is
829   begin
830      return To_Unbounded_String
831        (Fixed.Replace_Slice
832           (Source.Reference (1 .. Source.Last), Low, High, By));
833   end Replace_Slice;
834
835   procedure Replace_Slice
836     (Source : in out Unbounded_String;
837      Low    : Positive;
838      High   : Natural;
839      By     : String)
840   is
841      Old : String_Access := Source.Reference;
842   begin
843      Source.Reference := new String'
844        (Fixed.Replace_Slice
845           (Source.Reference (1 .. Source.Last), Low, High, By));
846      Source.Last := Source.Reference'Length;
847      Free (Old);
848   end Replace_Slice;
849
850   --------------------------
851   -- Set_Unbounded_String --
852   --------------------------
853
854   procedure Set_Unbounded_String
855     (Target : out Unbounded_String;
856      Source : String)
857   is
858      Old : String_Access := Target.Reference;
859   begin
860      Target.Last          := Source'Length;
861      Target.Reference     := new String (1 .. Source'Length);
862      Target.Reference.all := Source;
863      Free (Old);
864   end Set_Unbounded_String;
865
866   -----------
867   -- Slice --
868   -----------
869
870   function Slice
871     (Source : Unbounded_String;
872      Low    : Positive;
873      High   : Natural) return String
874   is
875   begin
876      --  Note: test of High > Length is in accordance with AI95-00128
877
878      if Low > Source.Last + 1 or else High > Source.Last then
879         raise Index_Error;
880      else
881         return Source.Reference (Low .. High);
882      end if;
883   end Slice;
884
885   ----------
886   -- Tail --
887   ----------
888
889   function Tail
890     (Source : Unbounded_String;
891      Count  : Natural;
892      Pad    : Character := Space) return Unbounded_String is
893   begin
894      return To_Unbounded_String
895        (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
896   end Tail;
897
898   procedure Tail
899     (Source : in out Unbounded_String;
900      Count  : Natural;
901      Pad    : Character := Space)
902   is
903      Old : String_Access := Source.Reference;
904   begin
905      Source.Reference := new String'
906        (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
907      Source.Last := Source.Reference'Length;
908      Free (Old);
909   end Tail;
910
911   ---------------
912   -- To_String --
913   ---------------
914
915   function To_String (Source : Unbounded_String) return String is
916   begin
917      return Source.Reference (1 .. Source.Last);
918   end To_String;
919
920   -------------------------
921   -- To_Unbounded_String --
922   -------------------------
923
924   function To_Unbounded_String (Source : String) return Unbounded_String is
925      Result : Unbounded_String;
926   begin
927      --  Do not allocate an empty string: keep the default
928
929      if Source'Length > 0 then
930         Result.Last          := Source'Length;
931         Result.Reference     := new String (1 .. Source'Length);
932         Result.Reference.all := Source;
933      end if;
934
935      return Result;
936   end To_Unbounded_String;
937
938   function To_Unbounded_String
939     (Length : Natural) return Unbounded_String
940   is
941      Result : Unbounded_String;
942
943   begin
944      --  Do not allocate an empty string: keep the default
945
946      if Length > 0 then
947         Result.Last      := Length;
948         Result.Reference := new String (1 .. Length);
949      end if;
950
951      return Result;
952   end To_Unbounded_String;
953
954   ---------------
955   -- Translate --
956   ---------------
957
958   function Translate
959     (Source  : Unbounded_String;
960      Mapping : Maps.Character_Mapping) return Unbounded_String
961   is
962   begin
963      return To_Unbounded_String
964        (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
965   end Translate;
966
967   procedure Translate
968     (Source  : in out Unbounded_String;
969      Mapping : Maps.Character_Mapping)
970   is
971   begin
972      Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
973   end Translate;
974
975   function Translate
976     (Source  : Unbounded_String;
977      Mapping : Maps.Character_Mapping_Function) return Unbounded_String
978   is
979   begin
980      return To_Unbounded_String
981        (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
982   end Translate;
983
984   procedure Translate
985     (Source  : in out Unbounded_String;
986      Mapping : Maps.Character_Mapping_Function)
987   is
988   begin
989      Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
990   end Translate;
991
992   ----------
993   -- Trim --
994   ----------
995
996   function Trim
997     (Source : Unbounded_String;
998      Side   : Trim_End) return Unbounded_String
999   is
1000   begin
1001      return To_Unbounded_String
1002        (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1003   end Trim;
1004
1005   procedure Trim
1006     (Source : in out Unbounded_String;
1007      Side   : Trim_End)
1008   is
1009      Old : String_Access := Source.Reference;
1010   begin
1011      Source.Reference := new String'
1012        (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1013      Source.Last      := Source.Reference'Length;
1014      Free (Old);
1015   end Trim;
1016
1017   function Trim
1018     (Source : Unbounded_String;
1019      Left   : Maps.Character_Set;
1020      Right  : Maps.Character_Set) return Unbounded_String
1021   is
1022   begin
1023      return To_Unbounded_String
1024        (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1025   end Trim;
1026
1027   procedure Trim
1028     (Source : in out Unbounded_String;
1029      Left   : Maps.Character_Set;
1030      Right  : Maps.Character_Set)
1031   is
1032      Old : String_Access := Source.Reference;
1033   begin
1034      Source.Reference := new String'
1035        (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1036      Source.Last      := Source.Reference'Length;
1037      Free (Old);
1038   end Trim;
1039
1040   ---------------------
1041   -- Unbounded_Slice --
1042   ---------------------
1043
1044   function Unbounded_Slice
1045     (Source : Unbounded_String;
1046      Low    : Positive;
1047      High   : Natural) return Unbounded_String
1048   is
1049   begin
1050      if Low > Source.Last + 1 or else High > Source.Last then
1051         raise Index_Error;
1052      else
1053         return To_Unbounded_String (Source.Reference.all (Low .. High));
1054      end if;
1055   end Unbounded_Slice;
1056
1057   procedure Unbounded_Slice
1058     (Source : Unbounded_String;
1059      Target : out Unbounded_String;
1060      Low    : Positive;
1061      High   : Natural)
1062   is
1063   begin
1064      if Low > Source.Last + 1 or else High > Source.Last then
1065         raise Index_Error;
1066      else
1067         Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1068      end if;
1069   end Unbounded_Slice;
1070
1071end Ada.Strings.Unbounded;
1072