OSDN Git Service

* gfortran.dg/ishft.f90: Remove kind suffix from BOZ constant
[pf3gnuchains/gcc-fork.git] / gcc / ada / a-stwiun.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT RUNTIME COMPONENTS                          --
4 --                                                                          --
5 --           A D A . S T R I N G S . W I D E _ U N B O U N D E D            --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 1992-2005 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 2,  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.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20 -- MA 02111-1307, USA.                                                      --
21 --                                                                          --
22 -- As a special exception,  if other files  instantiate  generics from this --
23 -- unit, or you link  this unit with other files  to produce an executable, --
24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
25 -- covered  by the  GNU  General  Public  License.  This exception does not --
26 -- however invalidate  any other reasons why  the executable file  might be --
27 -- covered by the  GNU Public License.                                      --
28 --                                                                          --
29 -- GNAT was originally developed  by the GNAT team at  New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
31 --                                                                          --
32 ------------------------------------------------------------------------------
33
34 with Ada.Strings.Wide_Fixed;
35 with Ada.Strings.Wide_Search;
36 with Ada.Unchecked_Deallocation;
37
38 package body Ada.Strings.Wide_Unbounded is
39
40    use Ada.Finalization;
41
42    procedure Realloc_For_Chunk
43      (Source     : in out Unbounded_Wide_String;
44       Chunk_Size : Natural);
45    pragma Inline (Realloc_For_Chunk);
46    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
47    --  is safe to add a string of this size at the end of the current
48    --  content. The real size allocated for the string is Chunk_Size + x %
49    --  of the current string size. This buffered handling makes the Append
50    --  unbounded wide string routines very fast.
51
52    ---------
53    -- "&" --
54    ---------
55
56    function "&"
57      (Left  : Unbounded_Wide_String;
58       Right : Unbounded_Wide_String) return Unbounded_Wide_String
59    is
60       L_Length : constant Natural := Left.Last;
61       R_Length : constant Natural := Right.Last;
62       Result   : Unbounded_Wide_String;
63
64    begin
65       Result.Last := L_Length + R_Length;
66
67       Result.Reference := new Wide_String (1 .. Result.Last);
68
69       Result.Reference (1 .. L_Length) :=
70         Left.Reference (1 .. Left.Last);
71       Result.Reference (L_Length + 1 .. Result.Last) :=
72         Right.Reference (1 .. Right.Last);
73
74       return Result;
75    end "&";
76
77    function "&"
78      (Left  : Unbounded_Wide_String;
79       Right : Wide_String) return Unbounded_Wide_String
80    is
81       L_Length : constant Natural := Left.Last;
82       Result   : Unbounded_Wide_String;
83
84    begin
85       Result.Last := L_Length + Right'Length;
86
87       Result.Reference := new Wide_String (1 .. Result.Last);
88
89       Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
90       Result.Reference (L_Length + 1 .. Result.Last) := Right;
91
92       return Result;
93    end "&";
94
95    function "&"
96      (Left  : Wide_String;
97       Right : Unbounded_Wide_String) return Unbounded_Wide_String
98    is
99       R_Length : constant Natural := Right.Last;
100       Result   : Unbounded_Wide_String;
101
102    begin
103       Result.Last := Left'Length + R_Length;
104
105       Result.Reference := new Wide_String (1 .. Result.Last);
106
107       Result.Reference (1 .. Left'Length) := Left;
108       Result.Reference (Left'Length + 1 .. Result.Last) :=
109         Right.Reference (1 .. Right.Last);
110
111       return Result;
112    end "&";
113
114    function "&"
115      (Left  : Unbounded_Wide_String;
116       Right : Wide_Character) return Unbounded_Wide_String
117    is
118       Result : Unbounded_Wide_String;
119
120    begin
121       Result.Last := Left.Last + 1;
122
123       Result.Reference := new Wide_String (1 .. Result.Last);
124
125       Result.Reference (1 .. Result.Last - 1) :=
126         Left.Reference (1 .. Left.Last);
127       Result.Reference (Result.Last) := Right;
128
129       return Result;
130    end "&";
131
132    function "&"
133      (Left  : Wide_Character;
134       Right : Unbounded_Wide_String) return Unbounded_Wide_String
135    is
136       Result : Unbounded_Wide_String;
137
138    begin
139       Result.Last := Right.Last + 1;
140
141       Result.Reference := new Wide_String (1 .. Result.Last);
142       Result.Reference (1) := Left;
143       Result.Reference (2 .. Result.Last) :=
144         Right.Reference (1 .. Right.Last);
145
146       return Result;
147    end "&";
148
149    ---------
150    -- "*" --
151    ---------
152
153    function "*"
154      (Left  : Natural;
155       Right : Wide_Character) return Unbounded_Wide_String
156    is
157       Result : Unbounded_Wide_String;
158
159    begin
160       Result.Last := Left;
161
162       Result.Reference := new Wide_String (1 .. Left);
163       for J in Result.Reference'Range loop
164          Result.Reference (J) := Right;
165       end loop;
166
167       return Result;
168    end "*";
169
170    function "*"
171      (Left  : Natural;
172       Right : Wide_String) return Unbounded_Wide_String
173    is
174       Len    : constant Natural := Right'Length;
175       K      : Positive;
176       Result : Unbounded_Wide_String;
177
178    begin
179       Result.Last := Left * Len;
180
181       Result.Reference := new Wide_String (1 .. Result.Last);
182
183       K := 1;
184       for J in 1 .. Left loop
185          Result.Reference (K .. K + Len - 1) := Right;
186          K := K + Len;
187       end loop;
188
189       return Result;
190    end "*";
191
192    function "*"
193      (Left  : Natural;
194       Right : Unbounded_Wide_String) return Unbounded_Wide_String
195    is
196       Len    : constant Natural := Right.Last;
197       K      : Positive;
198       Result   : Unbounded_Wide_String;
199
200    begin
201       Result.Last := Left * Len;
202
203       Result.Reference := new Wide_String (1 .. Result.Last);
204
205       K := 1;
206       for I in 1 .. Left loop
207          Result.Reference (K .. K + Len - 1) :=
208            Right.Reference (1 .. Right.Last);
209          K := K + Len;
210       end loop;
211
212       return Result;
213    end "*";
214
215    ---------
216    -- "<" --
217    ---------
218
219    function "<"
220      (Left  : Unbounded_Wide_String;
221       Right : Unbounded_Wide_String) return Boolean
222    is
223    begin
224       return
225         Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
226    end "<";
227
228    function "<"
229      (Left  : Unbounded_Wide_String;
230       Right : Wide_String) return Boolean
231    is
232    begin
233       return Left.Reference (1 .. Left.Last) < Right;
234    end "<";
235
236    function "<"
237      (Left  : Wide_String;
238       Right : Unbounded_Wide_String) return Boolean
239    is
240    begin
241       return Left < Right.Reference (1 .. Right.Last);
242    end "<";
243
244    ----------
245    -- "<=" --
246    ----------
247
248    function "<="
249      (Left  : Unbounded_Wide_String;
250       Right : Unbounded_Wide_String) return Boolean
251    is
252    begin
253       return
254         Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
255    end "<=";
256
257    function "<="
258      (Left  : Unbounded_Wide_String;
259       Right : Wide_String) return Boolean
260    is
261    begin
262       return Left.Reference (1 .. Left.Last) <= Right;
263    end "<=";
264
265    function "<="
266      (Left  : Wide_String;
267       Right : Unbounded_Wide_String) return Boolean
268    is
269    begin
270       return Left <= Right.Reference (1 .. Right.Last);
271    end "<=";
272
273    ---------
274    -- "=" --
275    ---------
276
277    function "="
278      (Left  : Unbounded_Wide_String;
279       Right : Unbounded_Wide_String) return Boolean
280    is
281    begin
282       return
283         Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
284    end "=";
285
286    function "="
287      (Left  : Unbounded_Wide_String;
288       Right : Wide_String) return Boolean
289    is
290    begin
291       return Left.Reference (1 .. Left.Last) = Right;
292    end "=";
293
294    function "="
295      (Left  : Wide_String;
296       Right : Unbounded_Wide_String) return Boolean
297    is
298    begin
299       return Left = Right.Reference (1 .. Right.Last);
300    end "=";
301
302    ---------
303    -- ">" --
304    ---------
305
306    function ">"
307      (Left  : Unbounded_Wide_String;
308       Right : Unbounded_Wide_String) return Boolean
309    is
310    begin
311       return
312         Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
313    end ">";
314
315    function ">"
316      (Left  : Unbounded_Wide_String;
317       Right : Wide_String) return Boolean
318    is
319    begin
320       return Left.Reference (1 .. Left.Last) > Right;
321    end ">";
322
323    function ">"
324      (Left  : Wide_String;
325       Right : Unbounded_Wide_String) return Boolean
326    is
327    begin
328       return Left > Right.Reference (1 .. Right.Last);
329    end ">";
330
331    ----------
332    -- ">=" --
333    ----------
334
335    function ">="
336      (Left  : Unbounded_Wide_String;
337       Right : Unbounded_Wide_String) return Boolean
338    is
339    begin
340       return
341         Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
342    end ">=";
343
344    function ">="
345      (Left  : Unbounded_Wide_String;
346       Right : Wide_String) return Boolean
347    is
348    begin
349       return Left.Reference (1 .. Left.Last) >= Right;
350    end ">=";
351
352    function ">="
353      (Left  : Wide_String;
354       Right : Unbounded_Wide_String) return Boolean
355    is
356    begin
357       return Left >= Right.Reference (1 .. Right.Last);
358    end ">=";
359
360    ------------
361    -- Adjust --
362    ------------
363
364    procedure Adjust (Object : in out Unbounded_Wide_String) is
365    begin
366       --  Copy string, except we do not copy the statically allocated
367       --  null string, since it can never be deallocated.
368       --  Note that we do not copy extra string room here to avoid dragging
369       --  unused allocated memory.
370
371       if Object.Reference /= Null_Wide_String'Access then
372          Object.Reference :=
373            new Wide_String'(Object.Reference (1 .. Object.Last));
374       end if;
375    end Adjust;
376
377    ------------
378    -- Append --
379    ------------
380
381    procedure Append
382      (Source   : in out Unbounded_Wide_String;
383       New_Item : Unbounded_Wide_String)
384    is
385    begin
386       Realloc_For_Chunk (Source, New_Item.Last);
387       Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
388         New_Item.Reference (1 .. New_Item.Last);
389       Source.Last := Source.Last + New_Item.Last;
390    end Append;
391
392    procedure Append
393      (Source   : in out Unbounded_Wide_String;
394       New_Item : Wide_String)
395    is
396    begin
397       Realloc_For_Chunk (Source, New_Item'Length);
398       Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
399         New_Item;
400       Source.Last := Source.Last + New_Item'Length;
401    end Append;
402
403    procedure Append
404      (Source   : in out Unbounded_Wide_String;
405       New_Item : Wide_Character)
406    is
407    begin
408       Realloc_For_Chunk (Source, 1);
409       Source.Reference (Source.Last + 1) := New_Item;
410       Source.Last := Source.Last + 1;
411    end Append;
412
413    -----------
414    -- Count --
415    -----------
416
417    function Count
418      (Source  : Unbounded_Wide_String;
419       Pattern : Wide_String;
420       Mapping : Wide_Maps.Wide_Character_Mapping :=
421                   Wide_Maps.Identity)
422       return Natural
423    is
424    begin
425       return Wide_Search.Count
426         (Source.Reference (1 .. Source.Last), Pattern, Mapping);
427    end Count;
428
429    function Count
430      (Source  : Unbounded_Wide_String;
431       Pattern : Wide_String;
432       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
433    is
434    begin
435       return Wide_Search.Count
436         (Source.Reference (1 .. Source.Last), Pattern, Mapping);
437    end Count;
438
439    function Count
440      (Source : Unbounded_Wide_String;
441       Set    : Wide_Maps.Wide_Character_Set) return Natural
442    is
443    begin
444       return Wide_Search.Count (Source.Reference (1 .. Source.Last), Set);
445    end Count;
446
447    ------------
448    -- Delete --
449    ------------
450
451    function Delete
452      (Source  : Unbounded_Wide_String;
453       From    : Positive;
454       Through : Natural) return Unbounded_Wide_String
455    is
456    begin
457       return To_Unbounded_Wide_String
458         (Wide_Fixed.Delete
459            (Source.Reference (1 .. Source.Last), From, Through));
460    end Delete;
461
462    procedure Delete
463      (Source  : in out Unbounded_Wide_String;
464       From    : Positive;
465       Through : Natural)
466    is
467    begin
468       if From > Through then
469          null;
470
471       elsif From < Source.Reference'First or else Through > Source.Last then
472          raise Index_Error;
473
474       else
475          declare
476             Len : constant Natural := Through - From + 1;
477
478          begin
479             Source.Reference (From .. Source.Last - Len) :=
480               Source.Reference (Through + 1 .. Source.Last);
481             Source.Last := Source.Last - Len;
482          end;
483       end if;
484    end Delete;
485
486    -------------
487    -- Element --
488    -------------
489
490    function Element
491      (Source : Unbounded_Wide_String;
492       Index  : Positive) return Wide_Character
493    is
494    begin
495       if Index <= Source.Last then
496          return Source.Reference (Index);
497       else
498          raise Strings.Index_Error;
499       end if;
500    end Element;
501
502    --------------
503    -- Finalize --
504    --------------
505
506    procedure Finalize (Object : in out Unbounded_Wide_String) is
507       procedure Deallocate is
508         new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
509
510    begin
511       --  Note: Don't try to free statically allocated null string
512
513       if Object.Reference /= Null_Wide_String'Access then
514          Deallocate (Object.Reference);
515          Object.Reference := Null_Unbounded_Wide_String.Reference;
516       end if;
517    end Finalize;
518
519    ----------------
520    -- Find_Token --
521    ----------------
522
523    procedure Find_Token
524      (Source : Unbounded_Wide_String;
525       Set    : Wide_Maps.Wide_Character_Set;
526       Test   : Strings.Membership;
527       First  : out Positive;
528       Last   : out Natural)
529    is
530    begin
531       Wide_Search.Find_Token
532         (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
533    end Find_Token;
534
535    ----------
536    -- Free --
537    ----------
538
539    procedure Free (X : in out Wide_String_Access) is
540       procedure Deallocate is
541          new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
542    begin
543       --  Note: Do not try to free statically allocated null string
544
545       if X /= Null_Unbounded_Wide_String.Reference then
546          Deallocate (X);
547       end if;
548    end Free;
549
550    ----------
551    -- Head --
552    ----------
553
554    function Head
555      (Source : Unbounded_Wide_String;
556       Count  : Natural;
557       Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
558    is
559    begin
560       return
561         To_Unbounded_Wide_String
562           (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
563    end Head;
564
565    procedure Head
566      (Source : in out Unbounded_Wide_String;
567       Count  : Natural;
568       Pad    : Wide_Character := Wide_Space)
569    is
570       Old : Wide_String_Access := Source.Reference;
571
572    begin
573       Source.Reference := new Wide_String'
574         (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
575       Source.Last := Source.Reference'Length;
576       Free (Old);
577    end Head;
578
579    -----------
580    -- Index --
581    -----------
582
583    function Index
584      (Source  : Unbounded_Wide_String;
585       Pattern : Wide_String;
586       Going   : Strings.Direction := Strings.Forward;
587       Mapping : Wide_Maps.Wide_Character_Mapping :=
588                         Wide_Maps.Identity) return Natural
589    is
590    begin
591       return Wide_Search.Index
592         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
593    end Index;
594
595    function Index
596      (Source  : Unbounded_Wide_String;
597       Pattern : Wide_String;
598       Going   : Direction := Forward;
599       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
600    is
601    begin
602       return Wide_Search.Index
603         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
604    end Index;
605
606    function Index
607      (Source : Unbounded_Wide_String;
608       Set    : Wide_Maps.Wide_Character_Set;
609       Test   : Strings.Membership := Strings.Inside;
610       Going  : Strings.Direction  := Strings.Forward) return Natural
611    is
612    begin
613       return Wide_Search.Index
614         (Source.Reference (1 .. Source.Last), Set, Test, Going);
615    end Index;
616
617    function Index_Non_Blank
618      (Source : Unbounded_Wide_String;
619       Going  : Strings.Direction := Strings.Forward) return Natural
620    is
621    begin
622       return Wide_Search.Index_Non_Blank
623         (Source.Reference (1 .. Source.Last), Going);
624    end Index_Non_Blank;
625
626    ----------------
627    -- Initialize --
628    ----------------
629
630    procedure Initialize (Object : in out Unbounded_Wide_String) is
631    begin
632       Object.Reference := Null_Unbounded_Wide_String.Reference;
633       Object.Last      := 0;
634    end Initialize;
635
636    ------------
637    -- Insert --
638    ------------
639
640    function Insert
641      (Source   : Unbounded_Wide_String;
642       Before   : Positive;
643       New_Item : Wide_String) return Unbounded_Wide_String
644    is
645    begin
646       return To_Unbounded_Wide_String
647         (Wide_Fixed.Insert
648            (Source.Reference (1 .. Source.Last), Before, New_Item));
649    end Insert;
650
651    procedure Insert
652      (Source   : in out Unbounded_Wide_String;
653       Before   : Positive;
654       New_Item : Wide_String)
655    is
656    begin
657       if Before not in Source.Reference'First .. Source.Last + 1 then
658          raise Index_Error;
659       end if;
660
661       Realloc_For_Chunk (Source, New_Item'Size);
662
663       Source.Reference
664         (Before +  New_Item'Length .. Source.Last + New_Item'Length) :=
665            Source.Reference (Before .. Source.Last);
666
667       Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
668       Source.Last := Source.Last + New_Item'Length;
669    end Insert;
670
671    ------------
672    -- Length --
673    ------------
674
675    function Length (Source : Unbounded_Wide_String) return Natural is
676    begin
677       return Source.Last;
678    end Length;
679
680    ---------------
681    -- Overwrite --
682    ---------------
683
684    function Overwrite
685      (Source   : Unbounded_Wide_String;
686       Position : Positive;
687       New_Item : Wide_String) return Unbounded_Wide_String
688    is
689    begin
690       return To_Unbounded_Wide_String
691         (Wide_Fixed.Overwrite
692            (Source.Reference (1 .. Source.Last), Position, New_Item));
693    end Overwrite;
694
695    procedure Overwrite
696      (Source    : in out Unbounded_Wide_String;
697       Position  : Positive;
698       New_Item  : Wide_String)
699    is
700       NL : constant Natural := New_Item'Length;
701
702    begin
703       if Position <= Source.Last - NL + 1 then
704          Source.Reference (Position .. Position + NL - 1) := New_Item;
705
706       else
707          declare
708             Old : Wide_String_Access := Source.Reference;
709
710          begin
711             Source.Reference := new Wide_String'
712               (Wide_Fixed.Overwrite
713                 (Source.Reference (1 .. Source.Last), Position, New_Item));
714             Source.Last := Source.Reference'Length;
715             Free (Old);
716          end;
717       end if;
718    end Overwrite;
719
720    -----------------------
721    -- Realloc_For_Chunk --
722    -----------------------
723
724    procedure Realloc_For_Chunk
725      (Source     : in out Unbounded_Wide_String;
726       Chunk_Size : Natural)
727    is
728       Growth_Factor : constant := 50;
729       S_Length      : constant Natural := Source.Reference'Length;
730
731    begin
732       if Chunk_Size > S_Length - Source.Last then
733          declare
734             Alloc_Chunk_Size : constant Positive :=
735                                  Chunk_Size + (S_Length / Growth_Factor);
736             Tmp : Wide_String_Access;
737
738          begin
739             Tmp := new Wide_String (1 .. S_Length + Alloc_Chunk_Size);
740             Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
741             Free (Source.Reference);
742             Source.Reference := Tmp;
743          end;
744       end if;
745    end Realloc_For_Chunk;
746
747    ---------------------
748    -- Replace_Element --
749    ---------------------
750
751    procedure Replace_Element
752      (Source : in out Unbounded_Wide_String;
753       Index  : Positive;
754       By     : Wide_Character)
755    is
756    begin
757       if Index <= Source.Last then
758          Source.Reference (Index) := By;
759       else
760          raise Strings.Index_Error;
761       end if;
762    end Replace_Element;
763
764    -------------------
765    -- Replace_Slice --
766    -------------------
767
768    function Replace_Slice
769      (Source : Unbounded_Wide_String;
770       Low    : Positive;
771       High   : Natural;
772       By     : Wide_String) return Unbounded_Wide_String
773    is
774    begin
775       return
776         To_Unbounded_Wide_String
777         (Wide_Fixed.Replace_Slice
778            (Source.Reference (1 .. Source.Last), Low, High, By));
779    end Replace_Slice;
780
781    procedure Replace_Slice
782      (Source   : in out Unbounded_Wide_String;
783       Low      : Positive;
784       High     : Natural;
785       By       : Wide_String)
786    is
787       Old : Wide_String_Access := Source.Reference;
788
789    begin
790       Source.Reference := new Wide_String'
791         (Wide_Fixed.Replace_Slice
792            (Source.Reference (1 .. Source.Last), Low, High, By));
793       Source.Last := Source.Reference'Length;
794       Free (Old);
795    end Replace_Slice;
796
797    -----------
798    -- Slice --
799    -----------
800
801    function Slice
802      (Source : Unbounded_Wide_String;
803       Low    : Positive;
804       High   : Natural) return Wide_String
805    is
806    begin
807       --  Note: test of High > Length is in accordance with AI95-00128
808
809       if Low > Source.Last + 1 or else High > Source.Last then
810          raise Index_Error;
811
812       else
813          return Source.Reference (Low .. High);
814       end if;
815    end Slice;
816
817    ----------
818    -- Tail --
819    ----------
820
821    function Tail
822      (Source : Unbounded_Wide_String;
823       Count  : Natural;
824       Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
825    is
826    begin
827       return To_Unbounded_Wide_String
828         (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
829    end Tail;
830
831    procedure Tail
832      (Source : in out Unbounded_Wide_String;
833       Count  : Natural;
834       Pad    : Wide_Character := Wide_Space)
835    is
836       Old : Wide_String_Access := Source.Reference;
837
838    begin
839       Source.Reference := new Wide_String'
840         (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
841       Source.Last := Source.Reference'Length;
842       Free (Old);
843    end Tail;
844
845    ------------------------------
846    -- To_Unbounded_Wide_String --
847    ------------------------------
848
849    function To_Unbounded_Wide_String
850      (Source : Wide_String) return Unbounded_Wide_String
851    is
852       Result : Unbounded_Wide_String;
853    begin
854       Result.Last          := Source'Length;
855       Result.Reference     := new Wide_String (1 .. Source'Length);
856       Result.Reference.all := Source;
857       return Result;
858    end To_Unbounded_Wide_String;
859
860    function To_Unbounded_Wide_String
861      (Length : Natural) return Unbounded_Wide_String
862    is
863       Result : Unbounded_Wide_String;
864    begin
865       Result.Last      := Length;
866       Result.Reference := new Wide_String (1 .. Length);
867       return Result;
868    end To_Unbounded_Wide_String;
869
870    --------------------
871    -- To_Wide_String --
872    --------------------
873
874    function To_Wide_String
875      (Source : Unbounded_Wide_String) return Wide_String
876    is
877    begin
878       return Source.Reference (1 .. Source.Last);
879    end To_Wide_String;
880
881    ---------------
882    -- Translate --
883    ---------------
884
885    function Translate
886      (Source  : Unbounded_Wide_String;
887       Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String
888    is
889    begin
890       return To_Unbounded_Wide_String
891         (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
892    end Translate;
893
894    procedure Translate
895      (Source  : in out Unbounded_Wide_String;
896       Mapping : Wide_Maps.Wide_Character_Mapping)
897    is
898    begin
899       Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
900    end Translate;
901
902    function Translate
903      (Source  : Unbounded_Wide_String;
904       Mapping : Wide_Maps.Wide_Character_Mapping_Function)
905       return Unbounded_Wide_String
906    is
907    begin
908       return To_Unbounded_Wide_String
909         (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
910    end Translate;
911
912    procedure Translate
913      (Source  : in out Unbounded_Wide_String;
914       Mapping : Wide_Maps.Wide_Character_Mapping_Function)
915    is
916    begin
917       Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
918    end Translate;
919
920    ----------
921    -- Trim --
922    ----------
923
924    function Trim
925      (Source : Unbounded_Wide_String;
926       Side   : Trim_End) return Unbounded_Wide_String
927    is
928    begin
929       return To_Unbounded_Wide_String
930         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
931    end Trim;
932
933    procedure Trim
934      (Source : in out Unbounded_Wide_String;
935       Side   : Trim_End)
936    is
937       Old : Wide_String_Access := Source.Reference;
938    begin
939       Source.Reference := new Wide_String'
940         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
941       Source.Last      := Source.Reference'Length;
942       Free (Old);
943    end Trim;
944
945    function Trim
946      (Source : Unbounded_Wide_String;
947       Left   : Wide_Maps.Wide_Character_Set;
948       Right  : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String
949    is
950    begin
951       return To_Unbounded_Wide_String
952         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
953    end Trim;
954
955    procedure Trim
956      (Source : in out Unbounded_Wide_String;
957       Left   : Wide_Maps.Wide_Character_Set;
958       Right  : Wide_Maps.Wide_Character_Set)
959    is
960       Old : Wide_String_Access := Source.Reference;
961
962    begin
963       Source.Reference := new Wide_String'
964         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
965       Source.Last      := Source.Reference'Length;
966       Free (Old);
967    end Trim;
968
969 end Ada.Strings.Wide_Unbounded;