1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . U N B O U N D E D --
9 -- Copyright (C) 1992-2002 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
.Fixed
;
35 with Ada
.Strings
.Search
;
36 with Ada
.Unchecked_Deallocation
;
38 package body Ada
.Strings
.Unbounded
is
42 procedure Realloc_For_Chunk
43 (Source
: in out Unbounded_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 string routines very fast.
56 function "&" (Left
, Right
: Unbounded_String
) return Unbounded_String
is
57 L_Length
: constant Natural := Left
.Last
;
58 R_Length
: constant Natural := Right
.Last
;
59 Result
: Unbounded_String
;
62 Result
.Last
:= L_Length
+ R_Length
;
64 Result
.Reference
:= new String (1 .. Result
.Last
);
66 Result
.Reference
(1 .. L_Length
) :=
67 Left
.Reference
(1 .. Left
.Last
);
68 Result
.Reference
(L_Length
+ 1 .. Result
.Last
) :=
69 Right
.Reference
(1 .. Right
.Last
);
75 (Left
: Unbounded_String
;
77 return Unbounded_String
79 L_Length
: constant Natural := Left
.Last
;
80 Result
: Unbounded_String
;
83 Result
.Last
:= L_Length
+ Right
'Length;
85 Result
.Reference
:= new String (1 .. Result
.Last
);
87 Result
.Reference
(1 .. L_Length
) := Left
.Reference
(1 .. Left
.Last
);
88 Result
.Reference
(L_Length
+ 1 .. Result
.Last
) := Right
;
95 Right
: Unbounded_String
)
96 return Unbounded_String
98 R_Length
: constant Natural := Right
.Last
;
99 Result
: Unbounded_String
;
102 Result
.Last
:= Left
'Length + R_Length
;
104 Result
.Reference
:= new String (1 .. Result
.Last
);
106 Result
.Reference
(1 .. Left
'Length) := Left
;
107 Result
.Reference
(Left
'Length + 1 .. Result
.Last
) :=
108 Right
.Reference
(1 .. Right
.Last
);
114 (Left
: Unbounded_String
;
116 return Unbounded_String
118 Result
: Unbounded_String
;
121 Result
.Last
:= Left
.Last
+ 1;
123 Result
.Reference
:= new String (1 .. Result
.Last
);
125 Result
.Reference
(1 .. Result
.Last
- 1) :=
126 Left
.Reference
(1 .. Left
.Last
);
127 Result
.Reference
(Result
.Last
) := Right
;
134 Right
: Unbounded_String
)
135 return Unbounded_String
137 Result
: Unbounded_String
;
140 Result
.Last
:= Right
.Last
+ 1;
142 Result
.Reference
:= new String (1 .. Result
.Last
);
143 Result
.Reference
(1) := Left
;
144 Result
.Reference
(2 .. Result
.Last
) :=
145 Right
.Reference
(1 .. Right
.Last
);
156 return Unbounded_String
158 Result
: Unbounded_String
;
163 Result
.Reference
:= new String (1 .. Left
);
164 for J
in Result
.Reference
'Range loop
165 Result
.Reference
(J
) := Right
;
174 return Unbounded_String
176 Len
: constant Natural := Right
'Length;
178 Result
: Unbounded_String
;
181 Result
.Last
:= Left
* Len
;
183 Result
.Reference
:= new String (1 .. Result
.Last
);
186 for J
in 1 .. Left
loop
187 Result
.Reference
(K
.. K
+ Len
- 1) := Right
;
196 Right
: Unbounded_String
)
197 return Unbounded_String
199 Len
: constant Natural := Right
.Last
;
201 Result
: Unbounded_String
;
204 Result
.Last
:= Left
* Len
;
206 Result
.Reference
:= new String (1 .. Result
.Last
);
209 for I
in 1 .. Left
loop
210 Result
.Reference
(K
.. K
+ Len
- 1) :=
211 Right
.Reference
(1 .. Right
.Last
);
222 function "<" (Left
, Right
: Unbounded_String
) return Boolean is
225 Left
.Reference
(1 .. Left
.Last
) < Right
.Reference
(1 .. Right
.Last
);
229 (Left
: Unbounded_String
;
234 return Left
.Reference
(1 .. Left
.Last
) < Right
;
239 Right
: Unbounded_String
)
243 return Left
< Right
.Reference
(1 .. Right
.Last
);
250 function "<=" (Left
, Right
: Unbounded_String
) return Boolean is
253 Left
.Reference
(1 .. Left
.Last
) <= Right
.Reference
(1 .. Right
.Last
);
257 (Left
: Unbounded_String
;
262 return Left
.Reference
(1 .. Left
.Last
) <= Right
;
267 Right
: Unbounded_String
)
271 return Left
<= Right
.Reference
(1 .. Right
.Last
);
278 function "=" (Left
, Right
: Unbounded_String
) return Boolean is
281 Left
.Reference
(1 .. Left
.Last
) = Right
.Reference
(1 .. Right
.Last
);
285 (Left
: Unbounded_String
;
290 return Left
.Reference
(1 .. Left
.Last
) = Right
;
295 Right
: Unbounded_String
)
299 return Left
= Right
.Reference
(1 .. Right
.Last
);
306 function ">" (Left
, Right
: Unbounded_String
) return Boolean is
309 Left
.Reference
(1 .. Left
.Last
) > Right
.Reference
(1 .. Right
.Last
);
313 (Left
: Unbounded_String
;
318 return Left
.Reference
(1 .. Left
.Last
) > Right
;
323 Right
: Unbounded_String
)
327 return Left
> Right
.Reference
(1 .. Right
.Last
);
334 function ">=" (Left
, Right
: Unbounded_String
) return Boolean is
337 Left
.Reference
(1 .. Left
.Last
) >= Right
.Reference
(1 .. Right
.Last
);
341 (Left
: Unbounded_String
;
346 return Left
.Reference
(1 .. Left
.Last
) >= Right
;
351 Right
: Unbounded_String
)
355 return Left
>= Right
.Reference
(1 .. Right
.Last
);
362 procedure Adjust
(Object
: in out Unbounded_String
) is
364 -- Copy string, except we do not copy the statically allocated null
365 -- string, since it can never be deallocated.
366 -- Note that we do not copy extra string room here to avoid dragging
367 -- unused allocated memory.
369 if Object
.Reference
/= Null_String
'Access then
370 Object
.Reference
:= new String'(Object.Reference (1 .. Object.Last));
379 (Source : in out Unbounded_String;
380 New_Item : Unbounded_String)
383 Realloc_For_Chunk (Source, New_Item.Last);
384 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
385 New_Item.Reference (1 .. New_Item.Last);
386 Source.Last := Source.Last + New_Item.Last;
390 (Source : in out Unbounded_String;
394 Realloc_For_Chunk (Source, New_Item'Length);
395 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
397 Source.Last := Source.Last + New_Item'Length;
401 (Source : in out Unbounded_String;
402 New_Item : Character)
405 Realloc_For_Chunk (Source, 1);
406 Source.Reference (Source.Last + 1) := New_Item;
407 Source.Last := Source.Last + 1;
415 (Source : Unbounded_String;
417 Mapping : Maps.Character_Mapping := Maps.Identity)
422 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
426 (Source : Unbounded_String;
428 Mapping : Maps.Character_Mapping_Function)
433 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
437 (Source : Unbounded_String;
438 Set : Maps.Character_Set)
442 return Search.Count (Source.Reference (1 .. Source.Last), Set);
450 (Source : Unbounded_String;
453 return Unbounded_String
458 (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
462 (Source : in out Unbounded_String;
467 if From > Through then
470 elsif From < Source.Reference'First or else Through > Source.Last then
475 Len : constant Natural := Through - From + 1;
478 Source.Reference (From .. Source.Last - Len) :=
479 Source.Reference (Through + 1 .. Source.Last);
480 Source.Last := Source.Last - Len;
490 (Source : Unbounded_String;
495 if Index <= Source.Last then
496 return Source.Reference (Index);
498 raise Strings.Index_Error;
506 procedure Finalize (Object : in out Unbounded_String) is
507 procedure Deallocate is
508 new Ada.Unchecked_Deallocation (String, String_Access);
511 -- Note: Don't try to free statically allocated null string
513 if Object.Reference /= Null_String'Access then
514 Deallocate (Object.Reference);
515 Object.Reference := Null_Unbounded_String.Reference;
525 (Source : Unbounded_String;
526 Set : Maps.Character_Set;
527 Test : Strings.Membership;
528 First : out Positive;
533 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
540 procedure Free (X : in out String_Access) is
541 procedure Deallocate is
542 new Ada.Unchecked_Deallocation (String, String_Access);
545 -- Note: Do not try to free statically allocated null string
547 if X /= Null_Unbounded_String.Reference then
557 (Source : Unbounded_String;
559 Pad : Character := Space)
560 return Unbounded_String
563 return To_Unbounded_String
564 (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
568 (Source : in out Unbounded_String;
570 Pad : Character := Space)
572 Old : String_Access := Source.Reference;
576 new String'(Fixed
.Head
(Source
.Reference
(1 .. Source
.Last
),
578 Source
.Last
:= Source
.Reference
'Length;
587 (Source
: Unbounded_String
;
589 Going
: Strings
.Direction
:= Strings
.Forward
;
590 Mapping
: Maps
.Character_Mapping
:= Maps
.Identity
)
595 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
599 (Source
: Unbounded_String
;
601 Going
: Direction
:= Forward
;
602 Mapping
: Maps
.Character_Mapping_Function
)
607 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
611 (Source
: Unbounded_String
;
612 Set
: Maps
.Character_Set
;
613 Test
: Strings
.Membership
:= Strings
.Inside
;
614 Going
: Strings
.Direction
:= Strings
.Forward
)
619 (Source
.Reference
(1 .. Source
.Last
), Set
, Test
, Going
);
622 function Index_Non_Blank
623 (Source
: Unbounded_String
;
624 Going
: Strings
.Direction
:= Strings
.Forward
)
629 Search
.Index_Non_Blank
(Source
.Reference
(1 .. Source
.Last
), Going
);
636 procedure Initialize
(Object
: in out Unbounded_String
) is
638 Object
.Reference
:= Null_Unbounded_String
.Reference
;
647 (Source
: Unbounded_String
;
650 return Unbounded_String
653 return To_Unbounded_String
654 (Fixed
.Insert
(Source
.Reference
(1 .. Source
.Last
), Before
, New_Item
));
658 (Source
: in out Unbounded_String
;
663 if Before
not in Source
.Reference
'First .. Source
.Last
+ 1 then
667 Realloc_For_Chunk
(Source
, New_Item
'Size);
670 (Before
+ New_Item
'Length .. Source
.Last
+ New_Item
'Length) :=
671 Source
.Reference
(Before
.. Source
.Last
);
673 Source
.Reference
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
674 Source
.Last
:= Source
.Last
+ New_Item
'Length;
681 function Length
(Source
: Unbounded_String
) return Natural is
691 (Source
: Unbounded_String
;
694 return Unbounded_String
is
697 return To_Unbounded_String
699 (Source
.Reference
(1 .. Source
.Last
), Position
, New_Item
));
703 (Source
: in out Unbounded_String
;
707 NL
: constant Natural := New_Item
'Length;
710 if Position
<= Source
.Last
- NL
+ 1 then
711 Source
.Reference
(Position
.. Position
+ NL
- 1) := New_Item
;
715 Old
: String_Access
:= Source
.Reference
;
718 Source
.Reference
:= new String'
720 (Source.Reference (1 .. Source.Last), Position, New_Item));
721 Source.Last := Source.Reference'Length;
727 -----------------------
728 -- Realloc_For_Chunk --
729 -----------------------
731 procedure Realloc_For_Chunk
732 (Source : in out Unbounded_String;
733 Chunk_Size : Natural)
735 Growth_Factor : constant := 50;
736 S_Length : constant Natural := Source.Reference'Length;
739 if Chunk_Size > S_Length - Source.Last then
741 Alloc_Chunk_Size : constant Positive :=
742 Chunk_Size + (S_Length / Growth_Factor);
746 Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
747 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
748 Free (Source.Reference);
749 Source.Reference := Tmp;
752 end Realloc_For_Chunk;
754 ---------------------
755 -- Replace_Element --
756 ---------------------
758 procedure Replace_Element
759 (Source : in out Unbounded_String;
764 if Index <= Source.Last then
765 Source.Reference (Index) := By;
767 raise Strings.Index_Error;
775 function Replace_Slice
776 (Source : Unbounded_String;
780 return Unbounded_String
783 return To_Unbounded_String
785 (Source.Reference (1 .. Source.Last), Low, High, By));
788 procedure Replace_Slice
789 (Source : in out Unbounded_String;
794 Old : String_Access := Source.Reference;
797 Source.Reference := new String'
799 (Source
.Reference
(1 .. Source
.Last
), Low
, High
, By
));
800 Source
.Last
:= Source
.Reference
'Length;
809 (Source
: Unbounded_String
;
815 -- Note: test of High > Length is in accordance with AI95-00128
817 if Low
> Source
.Last
+ 1 or else High
> Source
.Last
then
820 return Source
.Reference
(Low
.. High
);
829 (Source
: Unbounded_String
;
831 Pad
: Character := Space
)
832 return Unbounded_String
is
835 return To_Unbounded_String
836 (Fixed
.Tail
(Source
.Reference
(1 .. Source
.Last
), Count
, Pad
));
840 (Source
: in out Unbounded_String
;
842 Pad
: Character := Space
)
844 Old
: String_Access
:= Source
.Reference
;
847 Source
.Reference
:= new String'
848 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
849 Source.Last := Source.Reference'Length;
857 function To_String (Source : Unbounded_String) return String is
859 return Source.Reference (1 .. Source.Last);
862 -------------------------
863 -- To_Unbounded_String --
864 -------------------------
866 function To_Unbounded_String (Source : String) return Unbounded_String is
867 Result : Unbounded_String;
870 Result.Last := Source'Length;
871 Result.Reference := new String (1 .. Source'Length);
872 Result.Reference.all := Source;
874 end To_Unbounded_String;
876 function To_Unbounded_String
878 return Unbounded_String
880 Result : Unbounded_String;
883 Result.Last := Length;
884 Result.Reference := new String (1 .. Length);
886 end To_Unbounded_String;
893 (Source : Unbounded_String;
894 Mapping : Maps.Character_Mapping)
895 return Unbounded_String
898 return To_Unbounded_String
899 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
903 (Source : in out Unbounded_String;
904 Mapping : Maps.Character_Mapping)
907 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
911 (Source : Unbounded_String;
912 Mapping : Maps.Character_Mapping_Function)
913 return Unbounded_String
916 return To_Unbounded_String
917 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
921 (Source : in out Unbounded_String;
922 Mapping : Maps.Character_Mapping_Function)
925 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
933 (Source : Unbounded_String;
935 return Unbounded_String
938 return To_Unbounded_String
939 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
943 (Source : in out Unbounded_String;
946 Old : String_Access := Source.Reference;
949 Source.Reference := new String'
950 (Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Side
));
951 Source
.Last
:= Source
.Reference
'Length;
956 (Source
: Unbounded_String
;
957 Left
: Maps
.Character_Set
;
958 Right
: Maps
.Character_Set
)
959 return Unbounded_String
962 return To_Unbounded_String
963 (Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Left
, Right
));
967 (Source
: in out Unbounded_String
;
968 Left
: Maps
.Character_Set
;
969 Right
: Maps
.Character_Set
)
971 Old
: String_Access
:= Source
.Reference
;
974 Source
.Reference
:= new String'
975 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
976 Source.Last := Source.Reference'Length;
980 end Ada.Strings.Unbounded;