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 --
9 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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. --
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. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.Strings
.Wide_Fixed
;
35 with Ada
.Strings
.Wide_Search
;
36 with Ada
.Unchecked_Deallocation
;
38 package body Ada
.Strings
.Wide_Unbounded
is
47 (Left
: Unbounded_Wide_String
;
48 Right
: Unbounded_Wide_String
)
49 return Unbounded_Wide_String
51 L_Length
: constant Integer := Left
.Reference
.all'Length;
52 R_Length
: constant Integer := Right
.Reference
.all'Length;
53 Length
: constant Integer := L_Length
+ R_Length
;
54 Result
: Unbounded_Wide_String
;
57 Result
.Reference
:= new Wide_String (1 .. Length
);
58 Result
.Reference
.all (1 .. L_Length
) := Left
.Reference
.all;
59 Result
.Reference
.all (L_Length
+ 1 .. Length
) := Right
.Reference
.all;
64 (Left
: Unbounded_Wide_String
;
66 return Unbounded_Wide_String
68 L_Length
: constant Integer := Left
.Reference
.all'Length;
69 Length
: constant Integer := L_Length
+ Right
'Length;
70 Result
: Unbounded_Wide_String
;
73 Result
.Reference
:= new Wide_String (1 .. Length
);
74 Result
.Reference
.all (1 .. L_Length
) := Left
.Reference
.all;
75 Result
.Reference
.all (L_Length
+ 1 .. Length
) := Right
;
81 Right
: Unbounded_Wide_String
)
82 return Unbounded_Wide_String
84 R_Length
: constant Integer := Right
.Reference
.all'Length;
85 Length
: constant Integer := Left
'Length + R_Length
;
86 Result
: Unbounded_Wide_String
;
89 Result
.Reference
:= new Wide_String (1 .. Length
);
90 Result
.Reference
.all (1 .. Left
'Length) := Left
;
91 Result
.Reference
.all (Left
'Length + 1 .. Length
) := Right
.Reference
.all;
96 (Left
: Unbounded_Wide_String
;
97 Right
: Wide_Character)
98 return Unbounded_Wide_String
100 Length
: constant Integer := Left
.Reference
.all'Length + 1;
101 Result
: Unbounded_Wide_String
;
104 Result
.Reference
:= new Wide_String (1 .. Length
);
105 Result
.Reference
.all (1 .. Length
- 1) := Left
.Reference
.all;
106 Result
.Reference
.all (Length
) := Right
;
111 (Left
: Wide_Character;
112 Right
: Unbounded_Wide_String
)
113 return Unbounded_Wide_String
115 Length
: constant Integer := Right
.Reference
.all'Length + 1;
116 Result
: Unbounded_Wide_String
;
119 Result
.Reference
:= new Wide_String (1 .. Length
);
120 Result
.Reference
.all (1) := Left
;
121 Result
.Reference
.all (2 .. Length
) := Right
.Reference
.all;
131 Right
: Wide_Character)
132 return Unbounded_Wide_String
134 Result
: Unbounded_Wide_String
;
137 Result
.Reference
:= new Wide_String (1 .. Left
);
138 for J
in Result
.Reference
'Range loop
139 Result
.Reference
(J
) := Right
;
148 return Unbounded_Wide_String
150 Result
: Unbounded_Wide_String
;
153 Result
.Reference
:= new Wide_String (1 .. Left
* Right
'Length);
155 for J
in 1 .. Left
loop
157 (Right
'Length * J
- Right
'Length + 1 .. Right
'Length * J
) := Right
;
165 Right
: Unbounded_Wide_String
)
166 return Unbounded_Wide_String
168 R_Length
: constant Integer := Right
.Reference
.all'Length;
169 Result
: Unbounded_Wide_String
;
172 Result
.Reference
:= new Wide_String (1 .. Left
* R_Length
);
174 for I
in 1 .. Left
loop
175 Result
.Reference
.all (R_Length
* I
- R_Length
+ 1 .. R_Length
* I
) :=
187 (Left
: in Unbounded_Wide_String
;
188 Right
: in Unbounded_Wide_String
)
192 return Left
.Reference
.all < Right
.Reference
.all;
196 (Left
: in Unbounded_Wide_String
;
197 Right
: in Wide_String)
201 return Left
.Reference
.all < Right
;
205 (Left
: in Wide_String;
206 Right
: in Unbounded_Wide_String
)
210 return Left
< Right
.Reference
.all;
218 (Left
: in Unbounded_Wide_String
;
219 Right
: in Unbounded_Wide_String
)
223 return Left
.Reference
.all <= Right
.Reference
.all;
227 (Left
: in Unbounded_Wide_String
;
228 Right
: in Wide_String)
232 return Left
.Reference
.all <= Right
;
236 (Left
: in Wide_String;
237 Right
: in Unbounded_Wide_String
)
241 return Left
<= Right
.Reference
.all;
249 (Left
: in Unbounded_Wide_String
;
250 Right
: in Unbounded_Wide_String
)
254 return Left
.Reference
.all = Right
.Reference
.all;
258 (Left
: in Unbounded_Wide_String
;
259 Right
: in Wide_String)
263 return Left
.Reference
.all = Right
;
267 (Left
: in Wide_String;
268 Right
: in Unbounded_Wide_String
)
272 return Left
= Right
.Reference
.all;
280 (Left
: in Unbounded_Wide_String
;
281 Right
: in Unbounded_Wide_String
)
285 return Left
.Reference
.all > Right
.Reference
.all;
289 (Left
: in Unbounded_Wide_String
;
290 Right
: in Wide_String)
294 return Left
.Reference
.all > Right
;
298 (Left
: in Wide_String;
299 Right
: in Unbounded_Wide_String
)
303 return Left
> Right
.Reference
.all;
311 (Left
: in Unbounded_Wide_String
;
312 Right
: in Unbounded_Wide_String
)
316 return Left
.Reference
.all >= Right
.Reference
.all;
320 (Left
: in Unbounded_Wide_String
;
321 Right
: in Wide_String)
325 return Left
.Reference
.all >= Right
;
329 (Left
: in Wide_String;
330 Right
: in Unbounded_Wide_String
)
334 return Left
>= Right
.Reference
.all;
341 procedure Adjust
(Object
: in out Unbounded_Wide_String
) is
343 -- Copy string, except we do not copy the statically allocated
344 -- null string, since it can never be deallocated.
346 if Object
.Reference
/= Null_Wide_String
'Access then
347 Object
.Reference
:= new Wide_String'(Object.Reference.all);
356 (Source : in out Unbounded_Wide_String;
357 New_Item : in Unbounded_Wide_String)
359 S_Length : constant Integer := Source.Reference.all'Length;
360 Length : constant Integer := S_Length + New_Item.Reference.all'Length;
361 Temp : Wide_String_Access := Source.Reference;
364 if Source.Reference = Null_Wide_String'Access then
365 Source := To_Unbounded_Wide_String (New_Item.Reference.all);
369 Source.Reference := new Wide_String (1 .. Length);
371 Source.Reference.all (1 .. S_Length) := Temp.all;
372 Source.Reference.all (S_Length + 1 .. Length) := New_Item.Reference.all;
377 (Source : in out Unbounded_Wide_String;
378 New_Item : in Wide_String)
380 S_Length : constant Integer := Source.Reference.all'Length;
381 Length : constant Integer := S_Length + New_Item'Length;
382 Temp : Wide_String_Access := Source.Reference;
385 if Source.Reference = Null_Wide_String'Access then
386 Source := To_Unbounded_Wide_String (New_Item);
390 Source.Reference := new Wide_String (1 .. Length);
391 Source.Reference.all (1 .. S_Length) := Temp.all;
392 Source.Reference.all (S_Length + 1 .. Length) := New_Item;
397 (Source : in out Unbounded_Wide_String;
398 New_Item : in Wide_Character)
400 S_Length : constant Integer := Source.Reference.all'Length;
401 Length : constant Integer := S_Length + 1;
402 Temp : Wide_String_Access := Source.Reference;
405 if Source.Reference = Null_Wide_String'Access then
406 Source := To_Unbounded_Wide_String ("" & New_Item);
410 Source.Reference := new Wide_String (1 .. Length);
411 Source.Reference.all (1 .. S_Length) := Temp.all;
412 Source.Reference.all (S_Length + 1) := New_Item;
421 (Source : Unbounded_Wide_String;
422 Pattern : Wide_String;
423 Mapping : Wide_Maps.Wide_Character_Mapping :=
428 return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
432 (Source : in Unbounded_Wide_String;
433 Pattern : in Wide_String;
434 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
438 return Wide_Search.Count (Source.Reference.all, Pattern, Mapping);
442 (Source : Unbounded_Wide_String;
443 Set : Wide_Maps.Wide_Character_Set)
447 return Wide_Search.Count (Source.Reference.all, Set);
455 (Source : Unbounded_Wide_String;
458 return Unbounded_Wide_String
462 To_Unbounded_Wide_String
463 (Wide_Fixed.Delete (Source.Reference.all, From, Through));
467 (Source : in out Unbounded_Wide_String;
469 Through : in Natural)
471 Temp : Wide_String_Access := Source.Reference;
473 Source := To_Unbounded_Wide_String
474 (Wide_Fixed.Delete (Temp.all, From, Through));
482 (Source : Unbounded_Wide_String;
484 return Wide_Character
487 if Index <= Source.Reference.all'Last then
488 return Source.Reference.all (Index);
490 raise Strings.Index_Error;
498 procedure Finalize (Object : in out Unbounded_Wide_String) is
499 procedure Deallocate is
500 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
503 -- Note: Don't try to free statically allocated null string
505 if Object.Reference /= Null_Wide_String'Access then
506 Deallocate (Object.Reference);
507 Object.Reference := Null_Unbounded_Wide_String.Reference;
516 (Source : Unbounded_Wide_String;
517 Set : Wide_Maps.Wide_Character_Set;
518 Test : Strings.Membership;
519 First : out Positive;
523 Wide_Search.Find_Token (Source.Reference.all, Set, Test, First, Last);
530 procedure Free (X : in out Wide_String_Access) is
531 procedure Deallocate is
532 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
542 (Source : Unbounded_Wide_String;
544 Pad : Wide_Character := Wide_Space)
545 return Unbounded_Wide_String
549 To_Unbounded_Wide_String
550 (Wide_Fixed.Head (Source.Reference.all, Count, Pad));
554 (Source : in out Unbounded_Wide_String;
556 Pad : in Wide_Character := Wide_Space)
559 Source := To_Unbounded_Wide_String
560 (Wide_Fixed.Head (Source.Reference.all, Count, Pad));
568 (Source : Unbounded_Wide_String;
569 Pattern : Wide_String;
570 Going : Strings.Direction := Strings.Forward;
571 Mapping : Wide_Maps.Wide_Character_Mapping :=
577 Wide_Search.Index (Source.Reference.all, Pattern, Going, Mapping);
581 (Source : in Unbounded_Wide_String;
582 Pattern : in Wide_String;
583 Going : in Direction := Forward;
584 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
589 Wide_Search.Index (Source.Reference.all, Pattern, Going, Mapping);
593 (Source : Unbounded_Wide_String;
594 Set : Wide_Maps.Wide_Character_Set;
595 Test : Strings.Membership := Strings.Inside;
596 Going : Strings.Direction := Strings.Forward)
600 return Wide_Search.Index (Source.Reference.all, Set, Test, Going);
603 function Index_Non_Blank
604 (Source : Unbounded_Wide_String;
605 Going : Strings.Direction := Strings.Forward)
609 return Wide_Search.Index_Non_Blank (Source.Reference.all, Going);
616 procedure Initialize (Object : in out Unbounded_Wide_String) is
618 Object.Reference := Null_Unbounded_Wide_String.Reference;
626 (Source : Unbounded_Wide_String;
628 New_Item : Wide_String)
629 return Unbounded_Wide_String
633 To_Unbounded_Wide_String
634 (Wide_Fixed.Insert (Source.Reference.all, Before, New_Item));
638 (Source : in out Unbounded_Wide_String;
639 Before : in Positive;
640 New_Item : in Wide_String)
643 Source := To_Unbounded_Wide_String
644 (Wide_Fixed.Insert (Source.Reference.all, Before, New_Item));
651 function Length (Source : Unbounded_Wide_String) return Natural is
653 return Source.Reference.all'Length;
661 (Source : Unbounded_Wide_String;
663 New_Item : Wide_String)
664 return Unbounded_Wide_String is
667 return To_Unbounded_Wide_String
668 (Wide_Fixed.Overwrite (Source.Reference.all, Position, New_Item));
672 (Source : in out Unbounded_Wide_String;
673 Position : in Positive;
674 New_Item : in Wide_String)
676 Temp : Wide_String_Access := Source.Reference;
678 Source := To_Unbounded_Wide_String
679 (Wide_Fixed.Overwrite (Temp.all, Position, New_Item));
682 ---------------------
683 -- Replace_Element --
684 ---------------------
686 procedure Replace_Element
687 (Source : in out Unbounded_Wide_String;
692 if Index <= Source.Reference.all'Last then
693 Source.Reference.all (Index) := By;
695 raise Strings.Index_Error;
703 function Replace_Slice
704 (Source : Unbounded_Wide_String;
708 return Unbounded_Wide_String
712 To_Unbounded_Wide_String
713 (Wide_Fixed.Replace_Slice (Source.Reference.all, Low, High, By));
716 procedure Replace_Slice
717 (Source : in out Unbounded_Wide_String;
722 Temp : Wide_String_Access := Source.Reference;
724 Source := To_Unbounded_Wide_String
725 (Wide_Fixed.Replace_Slice (Temp.all, Low, High, By));
733 (Source : Unbounded_Wide_String;
738 Length : constant Natural := Source.Reference'Length;
741 -- Note: test of High > Length is in accordance with AI95-00128
743 if Low > Length + 1 or else High > Length then
748 Result : Wide_String (1 .. High - Low + 1);
751 Result := Source.Reference.all (Low .. High);
762 (Source : Unbounded_Wide_String;
764 Pad : Wide_Character := Wide_Space)
765 return Unbounded_Wide_String is
769 To_Unbounded_Wide_String
770 (Wide_Fixed.Tail (Source.Reference.all, Count, Pad));
774 (Source : in out Unbounded_Wide_String;
776 Pad : in Wide_Character := Wide_Space)
778 Temp : Wide_String_Access := Source.Reference;
781 Source := To_Unbounded_Wide_String
782 (Wide_Fixed.Tail (Temp.all, Count, Pad));
785 ------------------------------
786 -- To_Unbounded_Wide_String --
787 ------------------------------
789 function To_Unbounded_Wide_String
790 (Source : Wide_String)
791 return Unbounded_Wide_String
793 Result : Unbounded_Wide_String;
796 Result.Reference := new Wide_String (1 .. Source'Length);
797 Result.Reference.all := Source;
799 end To_Unbounded_Wide_String;
801 function To_Unbounded_Wide_String (Length : in Natural)
802 return Unbounded_Wide_String
804 Result : Unbounded_Wide_String;
807 Result.Reference := new Wide_String (1 .. Length);
809 end To_Unbounded_Wide_String;
815 function To_Wide_String
816 (Source : Unbounded_Wide_String)
820 return Source.Reference.all;
828 (Source : Unbounded_Wide_String;
829 Mapping : Wide_Maps.Wide_Character_Mapping)
830 return Unbounded_Wide_String
834 To_Unbounded_Wide_String
835 (Wide_Fixed.Translate (Source.Reference.all, Mapping));
839 (Source : in out Unbounded_Wide_String;
840 Mapping : Wide_Maps.Wide_Character_Mapping)
843 Wide_Fixed.Translate (Source.Reference.all, Mapping);
847 (Source : in Unbounded_Wide_String;
848 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
849 return Unbounded_Wide_String
853 To_Unbounded_Wide_String
854 (Wide_Fixed.Translate (Source.Reference.all, Mapping));
858 (Source : in out Unbounded_Wide_String;
859 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
862 Wide_Fixed.Translate (Source.Reference.all, Mapping);
870 (Source : in Unbounded_Wide_String;
872 return Unbounded_Wide_String
876 To_Unbounded_Wide_String
877 (Wide_Fixed.Trim (Source.Reference.all, Side));
881 (Source : in out Unbounded_Wide_String;
884 Old : Wide_String_Access := Source.Reference;
886 Source.Reference := new Wide_String'(Wide_Fixed
.Trim
(Old
.all, Side
));
891 (Source
: in Unbounded_Wide_String
;
892 Left
: in Wide_Maps
.Wide_Character_Set
;
893 Right
: in Wide_Maps
.Wide_Character_Set
)
894 return Unbounded_Wide_String
898 To_Unbounded_Wide_String
899 (Wide_Fixed
.Trim
(Source
.Reference
.all, Left
, Right
));
903 (Source
: in out Unbounded_Wide_String
;
904 Left
: in Wide_Maps
.Wide_Character_Set
;
905 Right
: in Wide_Maps
.Wide_Character_Set
)
907 Old
: Wide_String_Access
:= Source
.Reference
;
911 new Wide_String'(Wide_Fixed.Trim (Old.all, Left, Right));
915 end Ada.Strings.Wide_Unbounded;