1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME 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-2010, 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.Fixed;
33 with Ada.Strings.Search;
34 with Ada.Unchecked_Deallocation;
36 package body Ada.Strings.Unbounded is
45 (Left : Unbounded_String;
46 Right : Unbounded_String) return Unbounded_String
48 L_Length : constant Natural := Left.Last;
49 R_Length : constant Natural := Right.Last;
50 Result : Unbounded_String;
53 Result.Last := L_Length + R_Length;
55 Result.Reference := new 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_String;
67 Right : String) return Unbounded_String
69 L_Length : constant Natural := Left.Last;
70 Result : Unbounded_String;
73 Result.Last := L_Length + Right'Length;
75 Result.Reference := new 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_String) return Unbounded_String
87 R_Length : constant Natural := Right.Last;
88 Result : Unbounded_String;
91 Result.Last := Left'Length + R_Length;
93 Result.Reference := new 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_String;
104 Right : Character) return Unbounded_String
106 Result : Unbounded_String;
109 Result.Last := Left.Last + 1;
111 Result.Reference := new String (1 .. Result.Last);
113 Result.Reference (1 .. Result.Last - 1) :=
114 Left.Reference (1 .. Left.Last);
115 Result.Reference (Result.Last) := Right;
122 Right : Unbounded_String) return Unbounded_String
124 Result : Unbounded_String;
127 Result.Last := Right.Last + 1;
129 Result.Reference := new String (1 .. Result.Last);
130 Result.Reference (1) := Left;
131 Result.Reference (2 .. Result.Last) :=
132 Right.Reference (1 .. Right.Last);
142 Right : Character) return Unbounded_String
144 Result : Unbounded_String;
149 Result.Reference := new String (1 .. Left);
150 for J in Result.Reference'Range loop
151 Result.Reference (J) := Right;
159 Right : String) return Unbounded_String
161 Len : constant Natural := Right'Length;
163 Result : Unbounded_String;
166 Result.Last := Left * Len;
168 Result.Reference := new String (1 .. Result.Last);
171 for J in 1 .. Left loop
172 Result.Reference (K .. K + Len - 1) := Right;
181 Right : Unbounded_String) return Unbounded_String
183 Len : constant Natural := Right.Last;
185 Result : Unbounded_String;
188 Result.Last := Left * Len;
190 Result.Reference := new 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_String;
208 Right : Unbounded_String) return Boolean
212 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
216 (Left : Unbounded_String;
217 Right : String) return Boolean
220 return Left.Reference (1 .. Left.Last) < Right;
225 Right : Unbounded_String) return Boolean
228 return Left < Right.Reference (1 .. Right.Last);
236 (Left : Unbounded_String;
237 Right : Unbounded_String) return Boolean
241 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
245 (Left : Unbounded_String;
246 Right : String) return Boolean
249 return Left.Reference (1 .. Left.Last) <= Right;
254 Right : Unbounded_String) return Boolean
257 return Left <= Right.Reference (1 .. Right.Last);
265 (Left : Unbounded_String;
266 Right : Unbounded_String) return Boolean
270 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
274 (Left : Unbounded_String;
275 Right : String) return Boolean
278 return Left.Reference (1 .. Left.Last) = Right;
283 Right : Unbounded_String) return Boolean
286 return Left = Right.Reference (1 .. Right.Last);
294 (Left : Unbounded_String;
295 Right : Unbounded_String) return Boolean
299 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
303 (Left : Unbounded_String;
304 Right : String) return Boolean
307 return Left.Reference (1 .. Left.Last) > Right;
312 Right : Unbounded_String) return Boolean
315 return Left > Right.Reference (1 .. Right.Last);
323 (Left : Unbounded_String;
324 Right : Unbounded_String) return Boolean
328 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
332 (Left : Unbounded_String;
333 Right : String) return Boolean
336 return Left.Reference (1 .. Left.Last) >= Right;
341 Right : Unbounded_String) return Boolean
344 return Left >= Right.Reference (1 .. Right.Last);
351 procedure Adjust (Object : in out Unbounded_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_String'Access then
358 Object.Reference := new String'(Object.Reference (1 .. Object.Last));
367 (Source : in out Unbounded_String;
368 New_Item : Unbounded_String)
371 Realloc_For_Chunk (Source, New_Item.Last);
372 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
373 New_Item.Reference (1 .. New_Item.Last);
374 Source.Last := Source.Last + New_Item.Last;
378 (Source : in out Unbounded_String;
382 Realloc_For_Chunk (Source, New_Item'Length);
383 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
385 Source.Last := Source.Last + New_Item'Length;
389 (Source : in out Unbounded_String;
390 New_Item : Character)
393 Realloc_For_Chunk (Source, 1);
394 Source.Reference (Source.Last + 1) := New_Item;
395 Source.Last := Source.Last + 1;
403 (Source : Unbounded_String;
405 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
409 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
413 (Source : Unbounded_String;
415 Mapping : Maps.Character_Mapping_Function) return Natural
419 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
423 (Source : Unbounded_String;
424 Set : Maps.Character_Set) return Natural
427 return Search.Count (Source.Reference (1 .. Source.Last), Set);
435 (Source : Unbounded_String;
437 Through : Natural) return Unbounded_String
442 (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
446 (Source : in out Unbounded_String;
451 if From > Through then
454 elsif From < Source.Reference'First or else Through > Source.Last then
459 Len : constant Natural := Through - From + 1;
462 Source.Reference (From .. Source.Last - Len) :=
463 Source.Reference (Through + 1 .. Source.Last);
464 Source.Last := Source.Last - Len;
474 (Source : Unbounded_String;
475 Index : Positive) return Character
478 if Index <= Source.Last then
479 return Source.Reference (Index);
481 raise Strings.Index_Error;
489 procedure Finalize (Object : in out Unbounded_String) is
490 procedure Deallocate is
491 new Ada.Unchecked_Deallocation (String, String_Access);
494 -- Note: Don't try to free statically allocated null string
496 if Object.Reference /= Null_String'Access then
497 Deallocate (Object.Reference);
498 Object.Reference := Null_Unbounded_String.Reference;
508 (Source : Unbounded_String;
509 Set : Maps.Character_Set;
511 Test : Strings.Membership;
512 First : out Positive;
517 (Source.Reference (From .. Source.Last), Set, Test, First, Last);
521 (Source : Unbounded_String;
522 Set : Maps.Character_Set;
523 Test : Strings.Membership;
524 First : out Positive;
529 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
536 procedure Free (X : in out String_Access) is
537 procedure Deallocate is
538 new Ada.Unchecked_Deallocation (String, String_Access);
541 -- Note: Do not try to free statically allocated null string
543 if X /= Null_Unbounded_String.Reference then
553 (Source : Unbounded_String;
555 Pad : Character := Space) return Unbounded_String
558 return To_Unbounded_String
559 (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
563 (Source : in out Unbounded_String;
565 Pad : Character := Space)
567 Old : String_Access := Source.Reference;
570 new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
572 Source.Last := Source.Reference'Length;
581 (Source : Unbounded_String;
583 Going : Strings.Direction := Strings.Forward;
584 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
588 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
592 (Source : Unbounded_String;
594 Going : Direction := Forward;
595 Mapping : Maps.Character_Mapping_Function) return Natural
599 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
603 (Source : Unbounded_String;
604 Set : Maps.Character_Set;
605 Test : Strings.Membership := Strings.Inside;
606 Going : Strings.Direction := Strings.Forward) return Natural
610 (Source.Reference (1 .. Source.Last), Set, Test, Going);
614 (Source : Unbounded_String;
617 Going : Direction := Forward;
618 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
622 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
626 (Source : Unbounded_String;
629 Going : Direction := Forward;
630 Mapping : Maps.Character_Mapping_Function) return Natural
634 (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'Length);
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 := 32;
769 -- The growth factor controls how much extra space is allocated when
770 -- we have to increase the size of an allocated unbounded string. By
771 -- allocating extra space, we avoid the need to reallocate on every
772 -- append, particularly important when a string is built up by repeated
773 -- append operations of small pieces. This is expressed as a factor so
774 -- 32 means add 1/32 of the length of the string as growth space.
776 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
777 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
778 -- no memory loss as most (all?) malloc implementations are obliged to
779 -- align the returned memory on the maximum alignment as malloc does not
780 -- know the target alignment.
782 S_Length : constant Natural := Source.Reference'Length;
785 if Chunk_Size > S_Length - Source.Last then
787 New_Size : constant Positive :=
788 S_Length + Chunk_Size + (S_Length / Growth_Factor);
790 New_Rounded_Up_Size : constant Positive :=
791 ((New_Size - 1) / Min_Mul_Alloc + 1) *
794 Tmp : constant String_Access :=
795 new String (1 .. New_Rounded_Up_Size);
798 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
799 Free (Source.Reference);
800 Source.Reference := Tmp;
803 end Realloc_For_Chunk;
805 ---------------------
806 -- Replace_Element --
807 ---------------------
809 procedure Replace_Element
810 (Source : in out Unbounded_String;
815 if Index <= Source.Last then
816 Source.Reference (Index) := By;
818 raise Strings.Index_Error;
826 function Replace_Slice
827 (Source : Unbounded_String;
830 By : String) return Unbounded_String
833 return To_Unbounded_String
835 (Source.Reference (1 .. Source.Last), Low, High, By));
838 procedure Replace_Slice
839 (Source : in out Unbounded_String;
844 Old : String_Access := Source.Reference;
846 Source.Reference := new String'
848 (Source.Reference (1 .. Source.Last), Low, High, By));
849 Source.Last := Source.Reference'Length;
853 --------------------------
854 -- Set_Unbounded_String --
855 --------------------------
857 procedure Set_Unbounded_String
858 (Target : out Unbounded_String;
861 Old : String_Access := Target.Reference;
863 Target.Last := Source'Length;
864 Target.Reference := new String (1 .. Source'Length);
865 Target.Reference.all := Source;
867 end Set_Unbounded_String;
874 (Source : Unbounded_String;
876 High : Natural) return String
879 -- Note: test of High > Length is in accordance with AI95-00128
881 if Low > Source.Last + 1 or else High > Source.Last then
884 return Source.Reference (Low .. High);
893 (Source : Unbounded_String;
895 Pad : Character := Space) return Unbounded_String is
897 return To_Unbounded_String
898 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
902 (Source : in out Unbounded_String;
904 Pad : Character := Space)
906 Old : String_Access := Source.Reference;
908 Source.Reference := new String'
909 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
910 Source.Last := Source.Reference'Length;
918 function To_String (Source : Unbounded_String) return String is
920 return Source.Reference (1 .. Source.Last);
923 -------------------------
924 -- To_Unbounded_String --
925 -------------------------
927 function To_Unbounded_String (Source : String) return Unbounded_String is
928 Result : Unbounded_String;
930 -- Do not allocate an empty string: keep the default
932 if Source'Length > 0 then
933 Result.Last := Source'Length;
934 Result.Reference := new String (1 .. Source'Length);
935 Result.Reference.all := Source;
939 end To_Unbounded_String;
941 function To_Unbounded_String
942 (Length : Natural) return Unbounded_String
944 Result : Unbounded_String;
947 -- Do not allocate an empty string: keep the default
950 Result.Last := Length;
951 Result.Reference := new String (1 .. Length);
955 end To_Unbounded_String;
962 (Source : Unbounded_String;
963 Mapping : Maps.Character_Mapping) return Unbounded_String
966 return To_Unbounded_String
967 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
971 (Source : in out Unbounded_String;
972 Mapping : Maps.Character_Mapping)
975 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
979 (Source : Unbounded_String;
980 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
983 return To_Unbounded_String
984 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
988 (Source : in out Unbounded_String;
989 Mapping : Maps.Character_Mapping_Function)
992 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1000 (Source : Unbounded_String;
1001 Side : Trim_End) return Unbounded_String
1004 return To_Unbounded_String
1005 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1009 (Source : in out Unbounded_String;
1012 Old : String_Access := Source.Reference;
1014 Source.Reference := new String'
1015 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1016 Source.Last := Source.Reference'Length;
1021 (Source : Unbounded_String;
1022 Left : Maps.Character_Set;
1023 Right : Maps.Character_Set) return Unbounded_String
1026 return To_Unbounded_String
1027 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1031 (Source : in out Unbounded_String;
1032 Left : Maps.Character_Set;
1033 Right : Maps.Character_Set)
1035 Old : String_Access := Source.Reference;
1037 Source.Reference := new String'
1038 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1039 Source.Last := Source.Reference'Length;
1043 ---------------------
1044 -- Unbounded_Slice --
1045 ---------------------
1047 function Unbounded_Slice
1048 (Source : Unbounded_String;
1050 High : Natural) return Unbounded_String
1053 if Low > Source.Last + 1 or else High > Source.Last then
1056 return To_Unbounded_String (Source.Reference.all (Low .. High));
1058 end Unbounded_Slice;
1060 procedure Unbounded_Slice
1061 (Source : Unbounded_String;
1062 Target : out Unbounded_String;
1067 if Low > Source.Last + 1 or else High > Source.Last then
1070 Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1072 end Unbounded_Slice;
1074 end Ada.Strings.Unbounded;