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