1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . W I D E _ U N B O U N D E D --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 with Ada
.Strings
.Wide_Fixed
;
36 with Ada
.Strings
.Wide_Search
;
37 with Ada
.Unchecked_Deallocation
;
39 package body Ada
.Strings
.Wide_Unbounded
is
48 (Left
: Unbounded_Wide_String
;
49 Right
: Unbounded_Wide_String
)
50 return Unbounded_Wide_String
52 L_Length
: constant Integer := Left
.Reference
.all'Length;
53 R_Length
: constant Integer := Right
.Reference
.all'Length;
54 Length
: constant Integer := L_Length
+ R_Length
;
55 Result
: Unbounded_Wide_String
;
58 Result
.Reference
:= new Wide_String (1 .. Length
);
59 Result
.Reference
.all (1 .. L_Length
) := Left
.Reference
.all;
60 Result
.Reference
.all (L_Length
+ 1 .. Length
) := Right
.Reference
.all;
65 (Left
: Unbounded_Wide_String
;
67 return Unbounded_Wide_String
69 L_Length
: constant Integer := Left
.Reference
.all'Length;
70 Length
: constant Integer := L_Length
+ Right
'Length;
71 Result
: Unbounded_Wide_String
;
74 Result
.Reference
:= new Wide_String (1 .. Length
);
75 Result
.Reference
.all (1 .. L_Length
) := Left
.Reference
.all;
76 Result
.Reference
.all (L_Length
+ 1 .. Length
) := Right
;
82 Right
: Unbounded_Wide_String
)
83 return Unbounded_Wide_String
85 R_Length
: constant Integer := Right
.Reference
.all'Length;
86 Length
: constant Integer := Left
'Length + R_Length
;
87 Result
: Unbounded_Wide_String
;
90 Result
.Reference
:= new Wide_String (1 .. Length
);
91 Result
.Reference
.all (1 .. Left
'Length) := Left
;
92 Result
.Reference
.all (Left
'Length + 1 .. Length
) := Right
.Reference
.all;
97 (Left
: Unbounded_Wide_String
;
98 Right
: Wide_Character)
99 return Unbounded_Wide_String
101 Length
: constant Integer := Left
.Reference
.all'Length + 1;
102 Result
: Unbounded_Wide_String
;
105 Result
.Reference
:= new Wide_String (1 .. Length
);
106 Result
.Reference
.all (1 .. Length
- 1) := Left
.Reference
.all;
107 Result
.Reference
.all (Length
) := Right
;
112 (Left
: Wide_Character;
113 Right
: Unbounded_Wide_String
)
114 return Unbounded_Wide_String
116 Length
: constant Integer := Right
.Reference
.all'Length + 1;
117 Result
: Unbounded_Wide_String
;
120 Result
.Reference
:= new Wide_String (1 .. Length
);
121 Result
.Reference
.all (1) := Left
;
122 Result
.Reference
.all (2 .. Length
) := Right
.Reference
.all;
132 Right
: Wide_Character)
133 return Unbounded_Wide_String
135 Result
: Unbounded_Wide_String
;
138 Result
.Reference
:= new Wide_String (1 .. Left
);
139 for J
in Result
.Reference
'Range loop
140 Result
.Reference
(J
) := Right
;
149 return Unbounded_Wide_String
151 Result
: Unbounded_Wide_String
;
154 Result
.Reference
:= new Wide_String (1 .. Left
* Right
'Length);
156 for J
in 1 .. Left
loop
158 (Right
'Length * J
- Right
'Length + 1 .. Right
'Length * J
) := Right
;
166 Right
: Unbounded_Wide_String
)
167 return Unbounded_Wide_String
169 R_Length
: constant Integer := Right
.Reference
.all'Length;
170 Result
: Unbounded_Wide_String
;
173 Result
.Reference
:= new Wide_String (1 .. Left
* R_Length
);
175 for I
in 1 .. Left
loop
176 Result
.Reference
.all (R_Length
* I
- R_Length
+ 1 .. R_Length
* I
) :=
188 (Left
: in Unbounded_Wide_String
;
189 Right
: in Unbounded_Wide_String
)
193 return Left
.Reference
.all < Right
.Reference
.all;
197 (Left
: in Unbounded_Wide_String
;
198 Right
: in Wide_String)
202 return Left
.Reference
.all < Right
;
206 (Left
: in Wide_String;
207 Right
: in Unbounded_Wide_String
)
211 return Left
< Right
.Reference
.all;
219 (Left
: in Unbounded_Wide_String
;
220 Right
: in Unbounded_Wide_String
)
224 return Left
.Reference
.all <= Right
.Reference
.all;
228 (Left
: in Unbounded_Wide_String
;
229 Right
: in Wide_String)
233 return Left
.Reference
.all <= Right
;
237 (Left
: in Wide_String;
238 Right
: in Unbounded_Wide_String
)
242 return Left
<= Right
.Reference
.all;
250 (Left
: in Unbounded_Wide_String
;
251 Right
: in Unbounded_Wide_String
)
255 return Left
.Reference
.all = Right
.Reference
.all;
259 (Left
: in Unbounded_Wide_String
;
260 Right
: in Wide_String)
264 return Left
.Reference
.all = Right
;
268 (Left
: in Wide_String;
269 Right
: in Unbounded_Wide_String
)
273 return Left
= Right
.Reference
.all;
281 (Left
: in Unbounded_Wide_String
;
282 Right
: in Unbounded_Wide_String
)
286 return Left
.Reference
.all > Right
.Reference
.all;
290 (Left
: in Unbounded_Wide_String
;
291 Right
: in Wide_String)
295 return Left
.Reference
.all > Right
;
299 (Left
: in Wide_String;
300 Right
: in Unbounded_Wide_String
)
304 return Left
> Right
.Reference
.all;
312 (Left
: in Unbounded_Wide_String
;
313 Right
: in Unbounded_Wide_String
)
317 return Left
.Reference
.all >= Right
.Reference
.all;
321 (Left
: in Unbounded_Wide_String
;
322 Right
: in Wide_String)
326 return Left
.Reference
.all >= Right
;
330 (Left
: in Wide_String;
331 Right
: in Unbounded_Wide_String
)
335 return Left
>= Right
.Reference
.all;
342 procedure Adjust
(Object
: in out Unbounded_Wide_String
) is
344 -- Copy string, except we do not copy the statically allocated
345 -- null string, since it can never be deallocated.
347 if Object
.Reference
/= Null_Wide_String
'Access then
348 Object
.Reference
:= new Wide_String'(Object.Reference.all);
357 (Source : in out Unbounded_Wide_String;
358 New_Item : in Unbounded_Wide_String)
360 S_Length : constant Integer := Source.Reference.all'Length;
361 Length : constant Integer := S_Length + New_Item.Reference.all'Length;
362 Temp : Wide_String_Access := Source.Reference;
365 if Source.Reference = Null_Wide_String'Access then
366 Source := To_Unbounded_Wide_String (New_Item.Reference.all);
370 Source.Reference := new Wide_String (1 .. Length);
372 Source.Reference.all (1 .. S_Length) := Temp.all;
373 Source.Reference.all (S_Length + 1 .. Length) := New_Item.Reference.all;
378 (Source : in out Unbounded_Wide_String;
379 New_Item : in Wide_String)
381 S_Length : constant Integer := Source.Reference.all'Length;
382 Length : constant Integer := S_Length + New_Item'Length;
383 Temp : Wide_String_Access := Source.Reference;
386 if Source.Reference = Null_Wide_String'Access then
387 Source := To_Unbounded_Wide_String (New_Item);
391 Source.Reference := new Wide_String (1 .. Length);
392 Source.Reference.all (1 .. S_Length) := Temp.all;
393 Source.Reference.all (S_Length + 1 .. Length) := New_Item;
398 (Source : in out Unbounded_Wide_String;
399 New_Item : in Wide_Character)
401 S_Length : constant Integer := Source.Reference.all'Length;
402 Length : constant Integer := S_Length + 1;
403 Temp : Wide_String_Access := Source.Reference;
406 if Source.Reference = Null_Wide_String'Access then
407 Source := To_Unbounded_Wide_String ("" & New_Item);
411 Source.Reference := new Wide_String (1 .. Length);
412 Source.Reference.all (1 .. S_Length) := Temp.all;
413 Source.Reference.all (S_Length + 1) := New_Item;
422 (Source : Unbounded_Wide_String;
423 Pattern : Wide_String;
424 Mapping : Wide_Maps.Wide_Character_Mapping :=
429 return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
433 (Source : in Unbounded_Wide_String;
434 Pattern : in Wide_String;
435 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
439 return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
443 (Source : Unbounded_Wide_String;
444 Set : Wide_Maps.Wide_Character_Set)
448 return Wide_Search.Count (Source.Reference.all, Set);
456 (Source : Unbounded_Wide_String;
459 return Unbounded_Wide_String
463 To_Unbounded_Wide_String
464 (Wide_Fixed.Delete (Source.Reference.all, From, Through));
468 (Source : in out Unbounded_Wide_String;
470 Through : in Natural)
472 Temp : Wide_String_Access := Source.Reference;
474 Source := To_Unbounded_Wide_String
475 (Wide_Fixed.Delete (Temp.all, From, Through));
483 (Source : Unbounded_Wide_String;
485 return Wide_Character
488 if Index <= Source.Reference.all'Last then
489 return Source.Reference.all (Index);
491 raise Strings.Index_Error;
499 procedure Finalize (Object : in out Unbounded_Wide_String) is
500 procedure Deallocate is
501 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
504 -- Note: Don't try to free statically allocated null string
506 if Object.Reference /= Null_Wide_String'Access then
507 Deallocate (Object.Reference);
508 Object.Reference := Null_Unbounded_Wide_String.Reference;
517 (Source : Unbounded_Wide_String;
518 Set : Wide_Maps.Wide_Character_Set;
519 Test : Strings.Membership;
520 First : out Positive;
524 Wide_Search.Find_Token (Source.Reference.all, Set, Test, First, Last);
531 procedure Free (X : in out Wide_String_Access) is
532 procedure Deallocate is
533 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
543 (Source : Unbounded_Wide_String;
545 Pad : Wide_Character := Wide_Space)
546 return Unbounded_Wide_String
550 To_Unbounded_Wide_String
551 (Wide_Fixed.Head (Source.Reference.all, Count, Pad));
555 (Source : in out Unbounded_Wide_String;
557 Pad : in Wide_Character := Wide_Space)
560 Source := To_Unbounded_Wide_String
561 (Wide_Fixed.Head (Source.Reference.all, Count, Pad));
569 (Source : Unbounded_Wide_String;
570 Pattern : Wide_String;
571 Going : Strings.Direction := Strings.Forward;
572 Mapping : Wide_Maps.Wide_Character_Mapping :=
578 Wide_Search.Index (Source.Reference.all, Pattern, Going, Mapping);
582 (Source : in Unbounded_Wide_String;
583 Pattern : in Wide_String;
584 Going : in Direction := Forward;
585 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
590 Wide_Search.Index (Source.Reference.all, Pattern, Going, Mapping);
594 (Source : Unbounded_Wide_String;
595 Set : Wide_Maps.Wide_Character_Set;
596 Test : Strings.Membership := Strings.Inside;
597 Going : Strings.Direction := Strings.Forward)
601 return Wide_Search.Index (Source.Reference.all, Set, Test, Going);
604 function Index_Non_Blank
605 (Source : Unbounded_Wide_String;
606 Going : Strings.Direction := Strings.Forward)
610 return Wide_Search.Index_Non_Blank (Source.Reference.all, Going);
617 procedure Initialize (Object : in out Unbounded_Wide_String) is
619 Object.Reference := Null_Unbounded_Wide_String.Reference;
627 (Source : Unbounded_Wide_String;
629 New_Item : Wide_String)
630 return Unbounded_Wide_String
634 To_Unbounded_Wide_String
635 (Wide_Fixed.Insert (Source.Reference.all, Before, New_Item));
639 (Source : in out Unbounded_Wide_String;
640 Before : in Positive;
641 New_Item : in Wide_String)
644 Source := To_Unbounded_Wide_String
645 (Wide_Fixed.Insert (Source.Reference.all, Before, New_Item));
652 function Length (Source : Unbounded_Wide_String) return Natural is
654 return Source.Reference.all'Length;
662 (Source : Unbounded_Wide_String;
664 New_Item : Wide_String)
665 return Unbounded_Wide_String is
668 return To_Unbounded_Wide_String
669 (Wide_Fixed.Overwrite (Source.Reference.all, Position, New_Item));
673 (Source : in out Unbounded_Wide_String;
674 Position : in Positive;
675 New_Item : in Wide_String)
677 Temp : Wide_String_Access := Source.Reference;
679 Source := To_Unbounded_Wide_String
680 (Wide_Fixed.Overwrite (Temp.all, Position, New_Item));
683 ---------------------
684 -- Replace_Element --
685 ---------------------
687 procedure Replace_Element
688 (Source : in out Unbounded_Wide_String;
693 if Index <= Source.Reference.all'Last then
694 Source.Reference.all (Index) := By;
696 raise Strings.Index_Error;
704 function Replace_Slice
705 (Source : Unbounded_Wide_String;
709 return Unbounded_Wide_String
713 To_Unbounded_Wide_String
714 (Wide_Fixed.Replace_Slice (Source.Reference.all, Low, High, By));
717 procedure Replace_Slice
718 (Source : in out Unbounded_Wide_String;
723 Temp : Wide_String_Access := Source.Reference;
725 Source := To_Unbounded_Wide_String
726 (Wide_Fixed.Replace_Slice (Temp.all, Low, High, By));
734 (Source : Unbounded_Wide_String;
739 Length : constant Natural := Source.Reference'Length;
742 -- Note: test of High > Length is in accordance with AI95-00128
744 if Low > Length + 1 or else High > Length then
749 Result : Wide_String (1 .. High - Low + 1);
752 Result := Source.Reference.all (Low .. High);
763 (Source : Unbounded_Wide_String;
765 Pad : Wide_Character := Wide_Space)
766 return Unbounded_Wide_String is
770 To_Unbounded_Wide_String
771 (Wide_Fixed.Tail (Source.Reference.all, Count, Pad));
775 (Source : in out Unbounded_Wide_String;
777 Pad : in Wide_Character := Wide_Space)
779 Temp : Wide_String_Access := Source.Reference;
782 Source := To_Unbounded_Wide_String
783 (Wide_Fixed.Tail (Temp.all, Count, Pad));
786 ------------------------------
787 -- To_Unbounded_Wide_String --
788 ------------------------------
790 function To_Unbounded_Wide_String
791 (Source : Wide_String)
792 return Unbounded_Wide_String
794 Result : Unbounded_Wide_String;
797 Result.Reference := new Wide_String (1 .. Source'Length);
798 Result.Reference.all := Source;
800 end To_Unbounded_Wide_String;
802 function To_Unbounded_Wide_String (Length : in Natural)
803 return Unbounded_Wide_String
805 Result : Unbounded_Wide_String;
808 Result.Reference := new Wide_String (1 .. Length);
810 end To_Unbounded_Wide_String;
816 function To_Wide_String
817 (Source : Unbounded_Wide_String)
821 return Source.Reference.all;
829 (Source : Unbounded_Wide_String;
830 Mapping : Wide_Maps.Wide_Character_Mapping)
831 return Unbounded_Wide_String
835 To_Unbounded_Wide_String
836 (Wide_Fixed.Translate (Source.Reference.all, Mapping));
840 (Source : in out Unbounded_Wide_String;
841 Mapping : Wide_Maps.Wide_Character_Mapping)
844 Wide_Fixed.Translate (Source.Reference.all, Mapping);
848 (Source : in Unbounded_Wide_String;
849 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
850 return Unbounded_Wide_String
854 To_Unbounded_Wide_String
855 (Wide_Fixed.Translate (Source.Reference.all, Mapping));
859 (Source : in out Unbounded_Wide_String;
860 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
863 Wide_Fixed.Translate (Source.Reference.all, Mapping);
871 (Source : in Unbounded_Wide_String;
873 return Unbounded_Wide_String
877 To_Unbounded_Wide_String
878 (Wide_Fixed.Trim (Source.Reference.all, Side));
882 (Source : in out Unbounded_Wide_String;
885 Old : Wide_String_Access := Source.Reference;
887 Source.Reference := new Wide_String'(Wide_Fixed
.Trim
(Old
.all, Side
));
892 (Source
: in Unbounded_Wide_String
;
893 Left
: in Wide_Maps
.Wide_Character_Set
;
894 Right
: in Wide_Maps
.Wide_Character_Set
)
895 return Unbounded_Wide_String
899 To_Unbounded_Wide_String
900 (Wide_Fixed
.Trim
(Source
.Reference
.all, Left
, Right
));
904 (Source
: in out Unbounded_Wide_String
;
905 Left
: in Wide_Maps
.Wide_Character_Set
;
906 Right
: in Wide_Maps
.Wide_Character_Set
)
908 Old
: Wide_String_Access
:= Source
.Reference
;
912 new Wide_String'(Wide_Fixed.Trim (Old.all, Left, Right));
916 end Ada.Strings.Wide_Unbounded;