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-2005 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 content.
48 -- The real size allocated for the string is Chunk_Size + x of the current
49 -- string size. This buffered handling makes the Append unbounded string
50 -- routines very fast.
57 (Left
: Unbounded_String
;
58 Right
: Unbounded_String
) return Unbounded_String
60 L_Length
: constant Natural := Left
.Last
;
61 R_Length
: constant Natural := Right
.Last
;
62 Result
: Unbounded_String
;
65 Result
.Last
:= L_Length
+ R_Length
;
67 Result
.Reference
:= new String (1 .. Result
.Last
);
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
);
78 (Left
: Unbounded_String
;
79 Right
: String) return Unbounded_String
81 L_Length
: constant Natural := Left
.Last
;
82 Result
: Unbounded_String
;
85 Result
.Last
:= L_Length
+ Right
'Length;
87 Result
.Reference
:= new String (1 .. Result
.Last
);
89 Result
.Reference
(1 .. L_Length
) := Left
.Reference
(1 .. Left
.Last
);
90 Result
.Reference
(L_Length
+ 1 .. Result
.Last
) := Right
;
97 Right
: Unbounded_String
) return Unbounded_String
99 R_Length
: constant Natural := Right
.Last
;
100 Result
: Unbounded_String
;
103 Result
.Last
:= Left
'Length + R_Length
;
105 Result
.Reference
:= new String (1 .. Result
.Last
);
107 Result
.Reference
(1 .. Left
'Length) := Left
;
108 Result
.Reference
(Left
'Length + 1 .. Result
.Last
) :=
109 Right
.Reference
(1 .. Right
.Last
);
115 (Left
: Unbounded_String
;
116 Right
: Character) 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
) return Unbounded_String
136 Result
: Unbounded_String
;
139 Result
.Last
:= Right
.Last
+ 1;
141 Result
.Reference
:= new String (1 .. Result
.Last
);
142 Result
.Reference
(1) := Left
;
143 Result
.Reference
(2 .. Result
.Last
) :=
144 Right
.Reference
(1 .. Right
.Last
);
154 Right
: Character) return Unbounded_String
156 Result
: Unbounded_String
;
161 Result
.Reference
:= new String (1 .. Left
);
162 for J
in Result
.Reference
'Range loop
163 Result
.Reference
(J
) := Right
;
171 Right
: String) return Unbounded_String
173 Len
: constant Natural := Right
'Length;
175 Result
: Unbounded_String
;
178 Result
.Last
:= Left
* Len
;
180 Result
.Reference
:= new String (1 .. Result
.Last
);
183 for J
in 1 .. Left
loop
184 Result
.Reference
(K
.. K
+ Len
- 1) := Right
;
193 Right
: Unbounded_String
) return Unbounded_String
195 Len
: constant Natural := Right
.Last
;
197 Result
: Unbounded_String
;
200 Result
.Last
:= Left
* Len
;
202 Result
.Reference
:= new String (1 .. Result
.Last
);
205 for I
in 1 .. Left
loop
206 Result
.Reference
(K
.. K
+ Len
- 1) :=
207 Right
.Reference
(1 .. Right
.Last
);
219 (Left
: Unbounded_String
;
220 Right
: Unbounded_String
) return Boolean
224 Left
.Reference
(1 .. Left
.Last
) < Right
.Reference
(1 .. Right
.Last
);
228 (Left
: Unbounded_String
;
229 Right
: String) return Boolean
232 return Left
.Reference
(1 .. Left
.Last
) < Right
;
237 Right
: Unbounded_String
) return Boolean
240 return Left
< Right
.Reference
(1 .. Right
.Last
);
248 (Left
: Unbounded_String
;
249 Right
: Unbounded_String
) return Boolean
253 Left
.Reference
(1 .. Left
.Last
) <= Right
.Reference
(1 .. Right
.Last
);
257 (Left
: Unbounded_String
;
258 Right
: String) return Boolean
261 return Left
.Reference
(1 .. Left
.Last
) <= Right
;
266 Right
: Unbounded_String
) return Boolean
269 return Left
<= Right
.Reference
(1 .. Right
.Last
);
277 (Left
: Unbounded_String
;
278 Right
: Unbounded_String
) return Boolean
282 Left
.Reference
(1 .. Left
.Last
) = Right
.Reference
(1 .. Right
.Last
);
286 (Left
: Unbounded_String
;
287 Right
: String) return Boolean
290 return Left
.Reference
(1 .. Left
.Last
) = Right
;
295 Right
: Unbounded_String
) return Boolean
298 return Left
= Right
.Reference
(1 .. Right
.Last
);
306 (Left
: Unbounded_String
;
307 Right
: Unbounded_String
) return Boolean
311 Left
.Reference
(1 .. Left
.Last
) > Right
.Reference
(1 .. Right
.Last
);
315 (Left
: Unbounded_String
;
316 Right
: String) return Boolean
319 return Left
.Reference
(1 .. Left
.Last
) > Right
;
324 Right
: Unbounded_String
) return Boolean
327 return Left
> Right
.Reference
(1 .. Right
.Last
);
335 (Left
: Unbounded_String
;
336 Right
: Unbounded_String
) return Boolean
340 Left
.Reference
(1 .. Left
.Last
) >= Right
.Reference
(1 .. Right
.Last
);
344 (Left
: Unbounded_String
;
345 Right
: String) return Boolean
348 return Left
.Reference
(1 .. Left
.Last
) >= Right
;
353 Right
: Unbounded_String
) return Boolean
356 return Left
>= Right
.Reference
(1 .. Right
.Last
);
363 procedure Adjust
(Object
: in out Unbounded_String
) is
365 -- Copy string, except we do not copy the statically allocated null
366 -- string, since it can never be deallocated. Note that we do not copy
367 -- extra string room here to avoid dragging 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) return Natural
421 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
425 (Source : Unbounded_String;
427 Mapping : Maps.Character_Mapping_Function) return Natural
431 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
435 (Source : Unbounded_String;
436 Set : Maps.Character_Set) return Natural
439 return Search.Count (Source.Reference (1 .. Source.Last), Set);
447 (Source : Unbounded_String;
449 Through : Natural) return Unbounded_String
454 (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
458 (Source : in out Unbounded_String;
463 if From > Through then
466 elsif From < Source.Reference'First or else Through > Source.Last then
471 Len : constant Natural := Through - From + 1;
474 Source.Reference (From .. Source.Last - Len) :=
475 Source.Reference (Through + 1 .. Source.Last);
476 Source.Last := Source.Last - Len;
486 (Source : Unbounded_String;
487 Index : Positive) return Character
490 if Index <= Source.Last then
491 return Source.Reference (Index);
493 raise Strings.Index_Error;
501 procedure Finalize (Object : in out Unbounded_String) is
502 procedure Deallocate is
503 new Ada.Unchecked_Deallocation (String, String_Access);
506 -- Note: Don't try to free statically allocated null string
508 if Object.Reference /= Null_String'Access then
509 Deallocate (Object.Reference);
510 Object.Reference := Null_Unbounded_String.Reference;
520 (Source : Unbounded_String;
521 Set : Maps.Character_Set;
522 Test : Strings.Membership;
523 First : out Positive;
528 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
535 procedure Free (X : in out String_Access) is
536 procedure Deallocate is
537 new Ada.Unchecked_Deallocation (String, String_Access);
540 -- Note: Do not try to free statically allocated null string
542 if X /= Null_Unbounded_String.Reference then
552 (Source : Unbounded_String;
554 Pad : Character := Space) return Unbounded_String
557 return To_Unbounded_String
558 (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
562 (Source : in out Unbounded_String;
564 Pad : Character := Space)
566 Old : String_Access := Source.Reference;
569 new String'(Fixed
.Head
(Source
.Reference
(1 .. Source
.Last
),
571 Source
.Last
:= Source
.Reference
'Length;
580 (Source
: Unbounded_String
;
582 Going
: Strings
.Direction
:= Strings
.Forward
;
583 Mapping
: Maps
.Character_Mapping
:= Maps
.Identity
) return Natural
587 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
591 (Source
: Unbounded_String
;
593 Going
: Direction
:= Forward
;
594 Mapping
: Maps
.Character_Mapping_Function
) return Natural
598 (Source
.Reference
(1 .. Source
.Last
), Pattern
, Going
, Mapping
);
602 (Source
: Unbounded_String
;
603 Set
: Maps
.Character_Set
;
604 Test
: Strings
.Membership
:= Strings
.Inside
;
605 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
609 (Source
.Reference
(1 .. Source
.Last
), Set
, Test
, Going
);
613 (Source
: Unbounded_String
;
616 Going
: Direction
:= Forward
;
617 Mapping
: Maps
.Character_Mapping
:= Maps
.Identity
) return Natural
621 (Source
.Reference
(1 .. Source
.Last
), Pattern
, From
, Going
, Mapping
);
625 (Source
: Unbounded_String
;
628 Going
: Direction
:= Forward
;
629 Mapping
: Maps
.Character_Mapping_Function
) return Natural
633 (Source
.Reference
(1 .. Source
.Last
), Pattern
, From
, Going
, Mapping
);
638 (Source
: Unbounded_String
;
639 Set
: Maps
.Character_Set
;
641 Test
: Membership
:= Inside
;
642 Going
: Direction
:= Forward
) return Natural
646 (Source
.Reference
(1 .. Source
.Last
), Set
, From
, Test
, Going
);
649 function Index_Non_Blank
650 (Source
: Unbounded_String
;
651 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
655 Search
.Index_Non_Blank
656 (Source
.Reference
(1 .. Source
.Last
), Going
);
659 function Index_Non_Blank
660 (Source
: Unbounded_String
;
662 Going
: Direction
:= Forward
) return Natural
666 Search
.Index_Non_Blank
667 (Source
.Reference
(1 .. Source
.Last
), From
, Going
);
674 procedure Initialize
(Object
: in out Unbounded_String
) is
676 Object
.Reference
:= Null_Unbounded_String
.Reference
;
685 (Source
: Unbounded_String
;
687 New_Item
: String) return Unbounded_String
690 return To_Unbounded_String
691 (Fixed
.Insert
(Source
.Reference
(1 .. Source
.Last
), Before
, New_Item
));
695 (Source
: in out Unbounded_String
;
700 if Before
not in Source
.Reference
'First .. Source
.Last
+ 1 then
704 Realloc_For_Chunk
(Source
, New_Item
'Size);
707 (Before
+ New_Item
'Length .. Source
.Last
+ New_Item
'Length) :=
708 Source
.Reference
(Before
.. Source
.Last
);
710 Source
.Reference
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
711 Source
.Last
:= Source
.Last
+ New_Item
'Length;
718 function Length
(Source
: Unbounded_String
) return Natural is
728 (Source
: Unbounded_String
;
730 New_Item
: String) return Unbounded_String
733 return To_Unbounded_String
735 (Source
.Reference
(1 .. Source
.Last
), Position
, New_Item
));
739 (Source
: in out Unbounded_String
;
743 NL
: constant Natural := New_Item
'Length;
745 if Position
<= Source
.Last
- NL
+ 1 then
746 Source
.Reference
(Position
.. Position
+ NL
- 1) := New_Item
;
749 Old
: String_Access
:= Source
.Reference
;
751 Source
.Reference
:= new String'
753 (Source.Reference (1 .. Source.Last), Position, New_Item));
754 Source.Last := Source.Reference'Length;
760 -----------------------
761 -- Realloc_For_Chunk --
762 -----------------------
764 procedure Realloc_For_Chunk
765 (Source : in out Unbounded_String;
766 Chunk_Size : Natural)
768 Growth_Factor : constant := 50;
769 S_Length : constant Natural := Source.Reference'Length;
772 if Chunk_Size > S_Length - Source.Last then
774 Alloc_Chunk_Size : constant Positive :=
775 Chunk_Size + (S_Length / Growth_Factor);
778 Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
779 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
780 Free (Source.Reference);
781 Source.Reference := Tmp;
784 end Realloc_For_Chunk;
786 ---------------------
787 -- Replace_Element --
788 ---------------------
790 procedure Replace_Element
791 (Source : in out Unbounded_String;
796 if Index <= Source.Last then
797 Source.Reference (Index) := By;
799 raise Strings.Index_Error;
807 function Replace_Slice
808 (Source : Unbounded_String;
811 By : String) return Unbounded_String
814 return To_Unbounded_String
816 (Source.Reference (1 .. Source.Last), Low, High, By));
819 procedure Replace_Slice
820 (Source : in out Unbounded_String;
825 Old : String_Access := Source.Reference;
827 Source.Reference := new String'
829 (Source
.Reference
(1 .. Source
.Last
), Low
, High
, By
));
830 Source
.Last
:= Source
.Reference
'Length;
834 --------------------------
835 -- Set_Unbounded_String --
836 --------------------------
838 procedure Set_Unbounded_String
839 (Target
: out Unbounded_String
;
843 Target
.Last
:= Source
'Length;
844 Target
.Reference
:= new String (1 .. Source
'Length);
845 Target
.Reference
.all := Source
;
846 end Set_Unbounded_String
;
853 (Source
: Unbounded_String
;
855 High
: Natural) return String
858 -- Note: test of High > Length is in accordance with AI95-00128
860 if Low
> Source
.Last
+ 1 or else High
> Source
.Last
then
863 return Source
.Reference
(Low
.. High
);
872 (Source
: Unbounded_String
;
874 Pad
: Character := Space
) return Unbounded_String
is
876 return To_Unbounded_String
877 (Fixed
.Tail
(Source
.Reference
(1 .. Source
.Last
), Count
, Pad
));
881 (Source
: in out Unbounded_String
;
883 Pad
: Character := Space
)
885 Old
: String_Access
:= Source
.Reference
;
887 Source
.Reference
:= new String'
888 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
889 Source.Last := Source.Reference'Length;
897 function To_String (Source : Unbounded_String) return String is
899 return Source.Reference (1 .. Source.Last);
902 -------------------------
903 -- To_Unbounded_String --
904 -------------------------
906 function To_Unbounded_String (Source : String) return Unbounded_String is
907 Result : Unbounded_String;
909 Result.Last := Source'Length;
910 Result.Reference := new String (1 .. Source'Length);
911 Result.Reference.all := Source;
913 end To_Unbounded_String;
915 function To_Unbounded_String
916 (Length : Natural) return Unbounded_String
918 Result : Unbounded_String;
920 Result.Last := Length;
921 Result.Reference := new String (1 .. Length);
923 end To_Unbounded_String;
930 (Source : Unbounded_String;
931 Mapping : Maps.Character_Mapping) return Unbounded_String
934 return To_Unbounded_String
935 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
939 (Source : in out Unbounded_String;
940 Mapping : Maps.Character_Mapping)
943 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
947 (Source : Unbounded_String;
948 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
951 return To_Unbounded_String
952 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
956 (Source : in out Unbounded_String;
957 Mapping : Maps.Character_Mapping_Function)
960 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
968 (Source : Unbounded_String;
969 Side : Trim_End) return Unbounded_String
972 return To_Unbounded_String
973 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
977 (Source : in out Unbounded_String;
980 Old : String_Access := Source.Reference;
982 Source.Reference := new String'
983 (Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Side
));
984 Source
.Last
:= Source
.Reference
'Length;
989 (Source
: Unbounded_String
;
990 Left
: Maps
.Character_Set
;
991 Right
: Maps
.Character_Set
) return Unbounded_String
994 return To_Unbounded_String
995 (Fixed
.Trim
(Source
.Reference
(1 .. Source
.Last
), Left
, Right
));
999 (Source
: in out Unbounded_String
;
1000 Left
: Maps
.Character_Set
;
1001 Right
: Maps
.Character_Set
)
1003 Old
: String_Access
:= Source
.Reference
;
1005 Source
.Reference
:= new String'
1006 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1007 Source.Last := Source.Reference'Length;
1011 ---------------------
1012 -- Unbounded_Slice --
1013 ---------------------
1015 function Unbounded_Slice
1016 (Source : Unbounded_String;
1018 High : Natural) return Unbounded_String
1021 if Low > Source.Last + 1 or else High > Source.Last then
1024 return To_Unbounded_String (Source.Reference.all (Low .. High));
1026 end Unbounded_Slice;
1028 procedure Unbounded_Slice
1029 (Source : Unbounded_String;
1030 Target : out Unbounded_String;
1035 if Low > Source.Last + 1 or else High > Source.Last then
1038 Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1040 end Unbounded_Slice;
1042 end Ada.Strings.Unbounded;