1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME 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-2009, 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 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Strings
.Wide_Fixed
;
33 with Ada
.Strings
.Wide_Search
;
34 with Ada
.Unchecked_Deallocation
;
36 package body Ada
.Strings
.Wide_Unbounded
is
45 (Left
: Unbounded_Wide_String
;
46 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
48 L_Length
: constant Natural := Left
.Last
;
49 R_Length
: constant Natural := Right
.Last
;
50 Result
: Unbounded_Wide_String
;
53 Result
.Last
:= L_Length
+ R_Length
;
55 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
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
);
66 (Left
: Unbounded_Wide_String
;
67 Right
: Wide_String) return Unbounded_Wide_String
69 L_Length
: constant Natural := Left
.Last
;
70 Result
: Unbounded_Wide_String
;
73 Result
.Last
:= L_Length
+ Right
'Length;
75 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
77 Result
.Reference
(1 .. L_Length
) := Left
.Reference
(1 .. Left
.Last
);
78 Result
.Reference
(L_Length
+ 1 .. Result
.Last
) := Right
;
85 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
87 R_Length
: constant Natural := Right
.Last
;
88 Result
: Unbounded_Wide_String
;
91 Result
.Last
:= Left
'Length + R_Length
;
93 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
95 Result
.Reference
(1 .. Left
'Length) := Left
;
96 Result
.Reference
(Left
'Length + 1 .. Result
.Last
) :=
97 Right
.Reference
(1 .. Right
.Last
);
103 (Left
: Unbounded_Wide_String
;
104 Right
: Wide_Character) return Unbounded_Wide_String
106 Result
: Unbounded_Wide_String
;
109 Result
.Last
:= Left
.Last
+ 1;
111 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
113 Result
.Reference
(1 .. Result
.Last
- 1) :=
114 Left
.Reference
(1 .. Left
.Last
);
115 Result
.Reference
(Result
.Last
) := Right
;
121 (Left
: Wide_Character;
122 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
124 Result
: Unbounded_Wide_String
;
127 Result
.Last
:= Right
.Last
+ 1;
129 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
130 Result
.Reference
(1) := Left
;
131 Result
.Reference
(2 .. Result
.Last
) :=
132 Right
.Reference
(1 .. Right
.Last
);
142 Right
: Wide_Character) return Unbounded_Wide_String
144 Result
: Unbounded_Wide_String
;
149 Result
.Reference
:= new Wide_String (1 .. Left
);
150 for J
in Result
.Reference
'Range loop
151 Result
.Reference
(J
) := Right
;
159 Right
: Wide_String) return Unbounded_Wide_String
161 Len
: constant Natural := Right
'Length;
163 Result
: Unbounded_Wide_String
;
166 Result
.Last
:= Left
* Len
;
168 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
171 for J
in 1 .. Left
loop
172 Result
.Reference
(K
.. K
+ Len
- 1) := Right
;
181 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
183 Len
: constant Natural := Right
.Last
;
185 Result
: Unbounded_Wide_String
;
188 Result
.Last
:= Left
* Len
;
190 Result
.Reference
:= new Wide_String (1 .. Result
.Last
);
193 for J
in 1 .. Left
loop
194 Result
.Reference
(K
.. K
+ Len
- 1) :=
195 Right
.Reference
(1 .. Right
.Last
);
207 (Left
: Unbounded_Wide_String
;
208 Right
: Unbounded_Wide_String
) return Boolean
212 Left
.Reference
(1 .. Left
.Last
) < Right
.Reference
(1 .. Right
.Last
);
216 (Left
: Unbounded_Wide_String
;
217 Right
: Wide_String) return Boolean
220 return Left
.Reference
(1 .. Left
.Last
) < Right
;
225 Right
: Unbounded_Wide_String
) return Boolean
228 return Left
< Right
.Reference
(1 .. Right
.Last
);
236 (Left
: Unbounded_Wide_String
;
237 Right
: Unbounded_Wide_String
) return Boolean
241 Left
.Reference
(1 .. Left
.Last
) <= Right
.Reference
(1 .. Right
.Last
);
245 (Left
: Unbounded_Wide_String
;
246 Right
: Wide_String) return Boolean
249 return Left
.Reference
(1 .. Left
.Last
) <= Right
;
254 Right
: Unbounded_Wide_String
) return Boolean
257 return Left
<= Right
.Reference
(1 .. Right
.Last
);
265 (Left
: Unbounded_Wide_String
;
266 Right
: Unbounded_Wide_String
) return Boolean
270 Left
.Reference
(1 .. Left
.Last
) = Right
.Reference
(1 .. Right
.Last
);
274 (Left
: Unbounded_Wide_String
;
275 Right
: Wide_String) return Boolean
278 return Left
.Reference
(1 .. Left
.Last
) = Right
;
283 Right
: Unbounded_Wide_String
) return Boolean
286 return Left
= Right
.Reference
(1 .. Right
.Last
);
294 (Left
: Unbounded_Wide_String
;
295 Right
: Unbounded_Wide_String
) return Boolean
299 Left
.Reference
(1 .. Left
.Last
) > Right
.Reference
(1 .. Right
.Last
);
303 (Left
: Unbounded_Wide_String
;
304 Right
: Wide_String) return Boolean
307 return Left
.Reference
(1 .. Left
.Last
) > Right
;
312 Right
: Unbounded_Wide_String
) return Boolean
315 return Left
> Right
.Reference
(1 .. Right
.Last
);
323 (Left
: Unbounded_Wide_String
;
324 Right
: Unbounded_Wide_String
) return Boolean
328 Left
.Reference
(1 .. Left
.Last
) >= Right
.Reference
(1 .. Right
.Last
);
332 (Left
: Unbounded_Wide_String
;
333 Right
: Wide_String) return Boolean
336 return Left
.Reference
(1 .. Left
.Last
) >= Right
;
341 Right
: Unbounded_Wide_String
) return Boolean
344 return Left
>= Right
.Reference
(1 .. Right
.Last
);
351 procedure Adjust
(Object
: in out Unbounded_Wide_String
) is
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.
357 if Object
.Reference
/= Null_Wide_String
'Access then
359 new Wide_String'(Object.Reference (1 .. Object.Last));
368 (Source : in out Unbounded_Wide_String;
369 New_Item : Unbounded_Wide_String)
372 Realloc_For_Chunk (Source, New_Item.Last);
373 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
374 New_Item.Reference (1 .. New_Item.Last);
375 Source.Last := Source.Last + New_Item.Last;
379 (Source : in out Unbounded_Wide_String;
380 New_Item : Wide_String)
383 Realloc_For_Chunk (Source, New_Item'Length);
384 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
386 Source.Last := Source.Last + New_Item'Length;
390 (Source : in out Unbounded_Wide_String;
391 New_Item : Wide_Character)
394 Realloc_For_Chunk (Source, 1);
395 Source.Reference (Source.Last + 1) := New_Item;
396 Source.Last := Source.Last + 1;
404 (Source : Unbounded_Wide_String;
405 Pattern : Wide_String;
406 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
412 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
416 (Source : Unbounded_Wide_String;
417 Pattern : Wide_String;
418 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
423 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
427 (Source : Unbounded_Wide_String;
428 Set : Wide_Maps.Wide_Character_Set) return Natural
433 (Source.Reference (1 .. Source.Last), Set);
441 (Source : Unbounded_Wide_String;
443 Through : Natural) return Unbounded_Wide_String
447 To_Unbounded_Wide_String
449 (Source.Reference (1 .. Source.Last), From, Through));
453 (Source : in out Unbounded_Wide_String;
458 if From > Through then
461 elsif From < Source.Reference'First or else Through > Source.Last then
466 Len : constant Natural := Through - From + 1;
469 Source.Reference (From .. Source.Last - Len) :=
470 Source.Reference (Through + 1 .. Source.Last);
471 Source.Last := Source.Last - Len;
481 (Source : Unbounded_Wide_String;
482 Index : Positive) return Wide_Character
485 if Index <= Source.Last then
486 return Source.Reference (Index);
488 raise Strings.Index_Error;
496 procedure Finalize (Object : in out Unbounded_Wide_String) is
497 procedure Deallocate is
498 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
501 -- Note: Don't try to free statically allocated null string
503 if Object.Reference /= Null_Wide_String'Access then
504 Deallocate (Object.Reference);
505 Object.Reference := Null_Unbounded_Wide_String.Reference;
515 (Source : Unbounded_Wide_String;
516 Set : Wide_Maps.Wide_Character_Set;
517 Test : Strings.Membership;
518 First : out Positive;
522 Wide_Search.Find_Token
523 (Source.Reference (1 .. Source.Last), 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);
535 -- Note: Do not try to free statically allocated null string
537 if X /= Null_Unbounded_Wide_String.Reference then
547 (Source : Unbounded_Wide_String;
549 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
552 return To_Unbounded_Wide_String
553 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
557 (Source : in out Unbounded_Wide_String;
559 Pad : Wide_Character := Wide_Space)
561 Old : Wide_String_Access := Source.Reference;
565 (Wide_Fixed
.Head
(Source
.Reference
(1 .. Source
.Last
), Count
, Pad
));
566 Source
.Last
:= Source
.Reference
'Length;
575 (Source
: Unbounded_Wide_String
;
576 Pattern
: Wide_String;
577 Going
: Strings
.Direction
:= Strings
.Forward
;
578 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
584 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
588 (Source
: Unbounded_Wide_String
;
589 Pattern
: Wide_String;
590 Going
: Direction
:= Forward
;
591 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
596 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
600 (Source
: Unbounded_Wide_String
;
601 Set
: Wide_Maps
.Wide_Character_Set
;
602 Test
: Strings
.Membership
:= Strings
.Inside
;
603 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
606 return Wide_Search
.Index
607 (Source
.Reference
(1 .. Source
.Last
), Set
, Test
, Going
);
611 (Source
: Unbounded_Wide_String
;
612 Pattern
: Wide_String;
614 Going
: Direction
:= Forward
;
615 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
621 (Source
.Reference
(1 .. Source
.Last
), Pattern
, From
, Going
, Mapping
);
625 (Source
: Unbounded_Wide_String
;
626 Pattern
: Wide_String;
628 Going
: Direction
:= Forward
;
629 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
634 (Source
.Reference
(1 .. Source
.Last
), Pattern
, From
, Going
, Mapping
);
638 (Source
: Unbounded_Wide_String
;
639 Set
: Wide_Maps
.Wide_Character_Set
;
641 Test
: Membership
:= Inside
;
642 Going
: Direction
:= Forward
) return Natural
647 (Source
.Reference
(1 .. Source
.Last
), Set
, From
, Test
, Going
);
650 function Index_Non_Blank
651 (Source
: Unbounded_Wide_String
;
652 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
656 Wide_Search
.Index_Non_Blank
657 (Source
.Reference
(1 .. Source
.Last
), Going
);
660 function Index_Non_Blank
661 (Source
: Unbounded_Wide_String
;
663 Going
: Direction
:= Forward
) return Natural
667 Wide_Search
.Index_Non_Blank
668 (Source
.Reference
(1 .. Source
.Last
), From
, Going
);
675 procedure Initialize
(Object
: in out Unbounded_Wide_String
) is
677 Object
.Reference
:= Null_Unbounded_Wide_String
.Reference
;
686 (Source
: Unbounded_Wide_String
;
688 New_Item
: Wide_String) return Unbounded_Wide_String
692 To_Unbounded_Wide_String
694 (Source
.Reference
(1 .. Source
.Last
), Before
, New_Item
));
698 (Source
: in out Unbounded_Wide_String
;
700 New_Item
: Wide_String)
703 if Before
not in Source
.Reference
'First .. Source
.Last
+ 1 then
707 Realloc_For_Chunk
(Source
, New_Item
'Length);
710 (Before
+ New_Item
'Length .. Source
.Last
+ New_Item
'Length) :=
711 Source
.Reference
(Before
.. Source
.Last
);
713 Source
.Reference
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
714 Source
.Last
:= Source
.Last
+ New_Item
'Length;
721 function Length
(Source
: Unbounded_Wide_String
) return Natural is
731 (Source
: Unbounded_Wide_String
;
733 New_Item
: Wide_String) return Unbounded_Wide_String
737 To_Unbounded_Wide_String
738 (Wide_Fixed
.Overwrite
739 (Source
.Reference
(1 .. Source
.Last
), Position
, New_Item
));
743 (Source
: in out Unbounded_Wide_String
;
745 New_Item
: Wide_String)
747 NL
: constant Natural := New_Item
'Length;
749 if Position
<= Source
.Last
- NL
+ 1 then
750 Source
.Reference
(Position
.. Position
+ NL
- 1) := New_Item
;
753 Old
: Wide_String_Access
:= Source
.Reference
;
755 Source
.Reference
:= new Wide_String'
756 (Wide_Fixed.Overwrite
757 (Source.Reference (1 .. Source.Last), Position, New_Item));
758 Source.Last := Source.Reference'Length;
764 -----------------------
765 -- Realloc_For_Chunk --
766 -----------------------
768 procedure Realloc_For_Chunk
769 (Source : in out Unbounded_Wide_String;
770 Chunk_Size : Natural)
772 Growth_Factor : constant := 32;
773 -- The growth factor controls how much extra space is allocated when
774 -- we have to increase the size of an allocated unbounded string. By
775 -- allocating extra space, we avoid the need to reallocate on every
776 -- append, particularly important when a string is built up by repeated
777 -- append operations of small pieces. This is expressed as a factor so
778 -- 32 means add 1/32 of the length of the string as growth space.
780 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
781 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
782 -- no memory loss as most (all?) malloc implementations are obliged to
783 -- align the returned memory on the maximum alignment as malloc does not
784 -- know the target alignment.
786 S_Length : constant Natural := Source.Reference'Length;
789 if Chunk_Size > S_Length - Source.Last then
791 New_Size : constant Positive :=
792 S_Length + Chunk_Size + (S_Length / Growth_Factor);
794 New_Rounded_Up_Size : constant Positive :=
795 ((New_Size - 1) / Min_Mul_Alloc + 1) *
798 Tmp : constant Wide_String_Access :=
799 new Wide_String (1 .. New_Rounded_Up_Size);
802 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
803 Free (Source.Reference);
804 Source.Reference := Tmp;
807 end Realloc_For_Chunk;
809 ---------------------
810 -- Replace_Element --
811 ---------------------
813 procedure Replace_Element
814 (Source : in out Unbounded_Wide_String;
819 if Index <= Source.Last then
820 Source.Reference (Index) := By;
822 raise Strings.Index_Error;
830 function Replace_Slice
831 (Source : Unbounded_Wide_String;
834 By : Wide_String) return Unbounded_Wide_String
837 return To_Unbounded_Wide_String
838 (Wide_Fixed.Replace_Slice
839 (Source.Reference (1 .. Source.Last), Low, High, By));
842 procedure Replace_Slice
843 (Source : in out Unbounded_Wide_String;
848 Old : Wide_String_Access := Source.Reference;
850 Source.Reference := new Wide_String'
851 (Wide_Fixed
.Replace_Slice
852 (Source
.Reference
(1 .. Source
.Last
), Low
, High
, By
));
853 Source
.Last
:= Source
.Reference
'Length;
857 -------------------------------
858 -- Set_Unbounded_Wide_String --
859 -------------------------------
861 procedure Set_Unbounded_Wide_String
862 (Target
: out Unbounded_Wide_String
;
863 Source
: Wide_String)
866 Target
.Last
:= Source
'Length;
867 Target
.Reference
:= new Wide_String (1 .. Source
'Length);
868 Target
.Reference
.all := Source
;
869 end Set_Unbounded_Wide_String
;
876 (Source
: Unbounded_Wide_String
;
878 High
: Natural) return Wide_String
881 -- Note: test of High > Length is in accordance with AI95-00128
883 if Low
> Source
.Last
+ 1 or else High
> Source
.Last
then
886 return Source
.Reference
(Low
.. High
);
895 (Source
: Unbounded_Wide_String
;
897 Pad
: Wide_Character := Wide_Space
) return Unbounded_Wide_String
is
899 return To_Unbounded_Wide_String
900 (Wide_Fixed
.Tail
(Source
.Reference
(1 .. Source
.Last
), Count
, Pad
));
904 (Source
: in out Unbounded_Wide_String
;
906 Pad
: Wide_Character := Wide_Space
)
908 Old
: Wide_String_Access
:= Source
.Reference
;
910 Source
.Reference
:= new Wide_String'
911 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
912 Source.Last := Source.Reference'Length;
916 ------------------------------
917 -- To_Unbounded_Wide_String --
918 ------------------------------
920 function To_Unbounded_Wide_String
921 (Source : Wide_String)
922 return Unbounded_Wide_String
924 Result : Unbounded_Wide_String;
926 Result.Last := Source'Length;
927 Result.Reference := new Wide_String (1 .. Source'Length);
928 Result.Reference.all := Source;
930 end To_Unbounded_Wide_String;
932 function To_Unbounded_Wide_String
933 (Length : Natural) return Unbounded_Wide_String
935 Result : Unbounded_Wide_String;
937 Result.Last := Length;
938 Result.Reference := new Wide_String (1 .. Length);
940 end To_Unbounded_Wide_String;
946 function To_Wide_String
947 (Source : Unbounded_Wide_String)
951 return Source.Reference (1 .. Source.Last);
959 (Source : Unbounded_Wide_String;
960 Mapping : Wide_Maps.Wide_Character_Mapping)
961 return Unbounded_Wide_String
965 To_Unbounded_Wide_String
966 (Wide_Fixed.Translate
967 (Source.Reference (1 .. Source.Last), Mapping));
971 (Source : in out Unbounded_Wide_String;
972 Mapping : Wide_Maps.Wide_Character_Mapping)
975 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
979 (Source : Unbounded_Wide_String;
980 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
981 return Unbounded_Wide_String
985 To_Unbounded_Wide_String
986 (Wide_Fixed.Translate
987 (Source.Reference (1 .. Source.Last), Mapping));
991 (Source : in out Unbounded_Wide_String;
992 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
995 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1003 (Source : Unbounded_Wide_String;
1004 Side : Trim_End) return Unbounded_Wide_String
1008 To_Unbounded_Wide_String
1009 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1013 (Source : in out Unbounded_Wide_String;
1016 Old : Wide_String_Access := Source.Reference;
1020 (Wide_Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Side
));
1021 Source
.Last
:= Source
.Reference
'Length;
1026 (Source
: Unbounded_Wide_String
;
1027 Left
: Wide_Maps
.Wide_Character_Set
;
1028 Right
: Wide_Maps
.Wide_Character_Set
)
1029 return Unbounded_Wide_String
1033 To_Unbounded_Wide_String
1035 (Source
.Reference
(1 .. Source
.Last
), Left
, Right
));
1039 (Source
: in out Unbounded_Wide_String
;
1040 Left
: Wide_Maps
.Wide_Character_Set
;
1041 Right
: Wide_Maps
.Wide_Character_Set
)
1043 Old
: Wide_String_Access
:= Source
.Reference
;
1048 (Source.Reference (1 .. Source.Last), Left, Right));
1049 Source.Last := Source.Reference'Length;
1053 ---------------------
1054 -- Unbounded_Slice --
1055 ---------------------
1057 function Unbounded_Slice
1058 (Source : Unbounded_Wide_String;
1060 High : Natural) return Unbounded_Wide_String
1063 if Low > Source.Last + 1 or else High > Source.Last then
1066 return To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1068 end Unbounded_Slice;
1070 procedure Unbounded_Slice
1071 (Source : Unbounded_Wide_String;
1072 Target : out Unbounded_Wide_String;
1077 if Low > Source.Last + 1 or else High > Source.Last then
1081 To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1083 end Unbounded_Slice;
1085 end Ada.Strings.Wide_Unbounded;