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-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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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) return Unbounded_Wide_String
50 L_Length : constant Natural := Left.Last;
51 R_Length : constant Natural := Right.Last;
52 Result : Unbounded_Wide_String;
55 Result.Last := L_Length + R_Length;
57 Result.Reference := new Wide_String (1 .. Result.Last);
59 Result.Reference (1 .. L_Length) :=
60 Left.Reference (1 .. Left.Last);
61 Result.Reference (L_Length + 1 .. Result.Last) :=
62 Right.Reference (1 .. Right.Last);
68 (Left : Unbounded_Wide_String;
69 Right : Wide_String) return Unbounded_Wide_String
71 L_Length : constant Natural := Left.Last;
72 Result : Unbounded_Wide_String;
75 Result.Last := L_Length + Right'Length;
77 Result.Reference := new Wide_String (1 .. Result.Last);
79 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
80 Result.Reference (L_Length + 1 .. Result.Last) := Right;
87 Right : Unbounded_Wide_String) return Unbounded_Wide_String
89 R_Length : constant Natural := Right.Last;
90 Result : Unbounded_Wide_String;
93 Result.Last := Left'Length + R_Length;
95 Result.Reference := new Wide_String (1 .. Result.Last);
97 Result.Reference (1 .. Left'Length) := Left;
98 Result.Reference (Left'Length + 1 .. Result.Last) :=
99 Right.Reference (1 .. Right.Last);
105 (Left : Unbounded_Wide_String;
106 Right : Wide_Character) return Unbounded_Wide_String
108 Result : Unbounded_Wide_String;
111 Result.Last := Left.Last + 1;
113 Result.Reference := new Wide_String (1 .. Result.Last);
115 Result.Reference (1 .. Result.Last - 1) :=
116 Left.Reference (1 .. Left.Last);
117 Result.Reference (Result.Last) := Right;
123 (Left : Wide_Character;
124 Right : Unbounded_Wide_String) return Unbounded_Wide_String
126 Result : Unbounded_Wide_String;
129 Result.Last := Right.Last + 1;
131 Result.Reference := new Wide_String (1 .. Result.Last);
132 Result.Reference (1) := Left;
133 Result.Reference (2 .. Result.Last) :=
134 Right.Reference (1 .. Right.Last);
144 Right : Wide_Character) return Unbounded_Wide_String
146 Result : Unbounded_Wide_String;
151 Result.Reference := new Wide_String (1 .. Left);
152 for J in Result.Reference'Range loop
153 Result.Reference (J) := Right;
161 Right : Wide_String) return Unbounded_Wide_String
163 Len : constant Natural := Right'Length;
165 Result : Unbounded_Wide_String;
168 Result.Last := Left * Len;
170 Result.Reference := new Wide_String (1 .. Result.Last);
173 for J in 1 .. Left loop
174 Result.Reference (K .. K + Len - 1) := Right;
183 Right : Unbounded_Wide_String) return Unbounded_Wide_String
185 Len : constant Natural := Right.Last;
187 Result : Unbounded_Wide_String;
190 Result.Last := Left * Len;
192 Result.Reference := new Wide_String (1 .. Result.Last);
195 for J in 1 .. Left loop
196 Result.Reference (K .. K + Len - 1) :=
197 Right.Reference (1 .. Right.Last);
209 (Left : Unbounded_Wide_String;
210 Right : Unbounded_Wide_String) return Boolean
214 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
218 (Left : Unbounded_Wide_String;
219 Right : Wide_String) return Boolean
222 return Left.Reference (1 .. Left.Last) < Right;
227 Right : Unbounded_Wide_String) return Boolean
230 return Left < Right.Reference (1 .. Right.Last);
238 (Left : Unbounded_Wide_String;
239 Right : Unbounded_Wide_String) return Boolean
243 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
247 (Left : Unbounded_Wide_String;
248 Right : Wide_String) return Boolean
251 return Left.Reference (1 .. Left.Last) <= Right;
256 Right : Unbounded_Wide_String) return Boolean
259 return Left <= Right.Reference (1 .. Right.Last);
267 (Left : Unbounded_Wide_String;
268 Right : Unbounded_Wide_String) return Boolean
272 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
276 (Left : Unbounded_Wide_String;
277 Right : Wide_String) return Boolean
280 return Left.Reference (1 .. Left.Last) = Right;
285 Right : Unbounded_Wide_String) return Boolean
288 return Left = Right.Reference (1 .. Right.Last);
296 (Left : Unbounded_Wide_String;
297 Right : Unbounded_Wide_String) return Boolean
301 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
305 (Left : Unbounded_Wide_String;
306 Right : Wide_String) return Boolean
309 return Left.Reference (1 .. Left.Last) > Right;
314 Right : Unbounded_Wide_String) return Boolean
317 return Left > Right.Reference (1 .. Right.Last);
325 (Left : Unbounded_Wide_String;
326 Right : Unbounded_Wide_String) return Boolean
330 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
334 (Left : Unbounded_Wide_String;
335 Right : Wide_String) return Boolean
338 return Left.Reference (1 .. Left.Last) >= Right;
343 Right : Unbounded_Wide_String) return Boolean
346 return Left >= Right.Reference (1 .. Right.Last);
353 procedure Adjust (Object : in out Unbounded_Wide_String) is
355 -- Copy string, except we do not copy the statically allocated null
356 -- string, since it can never be deallocated. Note that we do not copy
357 -- extra string room here to avoid dragging unused allocated memory.
359 if Object.Reference /= Null_Wide_String'Access then
361 new Wide_String'(Object.Reference (1 .. Object.Last));
370 (Source : in out Unbounded_Wide_String;
371 New_Item : Unbounded_Wide_String)
374 Realloc_For_Chunk (Source, New_Item.Last);
375 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
376 New_Item.Reference (1 .. New_Item.Last);
377 Source.Last := Source.Last + New_Item.Last;
381 (Source : in out Unbounded_Wide_String;
382 New_Item : Wide_String)
385 Realloc_For_Chunk (Source, New_Item'Length);
386 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
388 Source.Last := Source.Last + New_Item'Length;
392 (Source : in out Unbounded_Wide_String;
393 New_Item : Wide_Character)
396 Realloc_For_Chunk (Source, 1);
397 Source.Reference (Source.Last + 1) := New_Item;
398 Source.Last := Source.Last + 1;
406 (Source : Unbounded_Wide_String;
407 Pattern : Wide_String;
408 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
414 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
418 (Source : Unbounded_Wide_String;
419 Pattern : Wide_String;
420 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
425 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
429 (Source : Unbounded_Wide_String;
430 Set : Wide_Maps.Wide_Character_Set) return Natural
435 (Source.Reference (1 .. Source.Last), Set);
443 (Source : Unbounded_Wide_String;
445 Through : Natural) return Unbounded_Wide_String
449 To_Unbounded_Wide_String
451 (Source.Reference (1 .. Source.Last), From, Through));
455 (Source : in out Unbounded_Wide_String;
460 if From > Through then
463 elsif From < Source.Reference'First or else Through > Source.Last then
468 Len : constant Natural := Through - From + 1;
471 Source.Reference (From .. Source.Last - Len) :=
472 Source.Reference (Through + 1 .. Source.Last);
473 Source.Last := Source.Last - Len;
483 (Source : Unbounded_Wide_String;
484 Index : Positive) return Wide_Character
487 if Index <= Source.Last then
488 return Source.Reference (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;
517 (Source : Unbounded_Wide_String;
518 Set : Wide_Maps.Wide_Character_Set;
519 Test : Strings.Membership;
520 First : out Positive;
524 Wide_Search.Find_Token
525 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
532 procedure Free (X : in out Wide_String_Access) is
533 procedure Deallocate is
534 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
537 -- Note: Do not try to free statically allocated null string
539 if X /= Null_Unbounded_Wide_String.Reference then
549 (Source : Unbounded_Wide_String;
551 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
554 return To_Unbounded_Wide_String
555 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
559 (Source : in out Unbounded_Wide_String;
561 Pad : Wide_Character := Wide_Space)
563 Old : Wide_String_Access := Source.Reference;
567 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
568 Source.Last := Source.Reference'Length;
577 (Source : Unbounded_Wide_String;
578 Pattern : Wide_String;
579 Going : Strings.Direction := Strings.Forward;
580 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
586 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
590 (Source : Unbounded_Wide_String;
591 Pattern : Wide_String;
592 Going : Direction := Forward;
593 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
598 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
602 (Source : Unbounded_Wide_String;
603 Set : Wide_Maps.Wide_Character_Set;
604 Test : Strings.Membership := Strings.Inside;
605 Going : Strings.Direction := Strings.Forward) return Natural
608 return Wide_Search.Index
609 (Source.Reference (1 .. Source.Last), Set, Test, Going);
613 (Source : Unbounded_Wide_String;
614 Pattern : Wide_String;
616 Going : Direction := Forward;
617 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
623 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
627 (Source : Unbounded_Wide_String;
628 Pattern : Wide_String;
630 Going : Direction := Forward;
631 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
636 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
640 (Source : Unbounded_Wide_String;
641 Set : Wide_Maps.Wide_Character_Set;
643 Test : Membership := Inside;
644 Going : Direction := Forward) return Natural
649 (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
652 function Index_Non_Blank
653 (Source : Unbounded_Wide_String;
654 Going : Strings.Direction := Strings.Forward) return Natural
658 Wide_Search.Index_Non_Blank
659 (Source.Reference (1 .. Source.Last), Going);
662 function Index_Non_Blank
663 (Source : Unbounded_Wide_String;
665 Going : Direction := Forward) return Natural
669 Wide_Search.Index_Non_Blank
670 (Source.Reference (1 .. Source.Last), From, Going);
677 procedure Initialize (Object : in out Unbounded_Wide_String) is
679 Object.Reference := Null_Unbounded_Wide_String.Reference;
688 (Source : Unbounded_Wide_String;
690 New_Item : Wide_String) return Unbounded_Wide_String
694 To_Unbounded_Wide_String
696 (Source.Reference (1 .. Source.Last), Before, New_Item));
700 (Source : in out Unbounded_Wide_String;
702 New_Item : Wide_String)
705 if Before not in Source.Reference'First .. Source.Last + 1 then
709 Realloc_For_Chunk (Source, New_Item'Size);
712 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
713 Source.Reference (Before .. Source.Last);
715 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
716 Source.Last := Source.Last + New_Item'Length;
723 function Length (Source : Unbounded_Wide_String) return Natural is
733 (Source : Unbounded_Wide_String;
735 New_Item : Wide_String) return Unbounded_Wide_String
739 To_Unbounded_Wide_String
740 (Wide_Fixed.Overwrite
741 (Source.Reference (1 .. Source.Last), Position, New_Item));
745 (Source : in out Unbounded_Wide_String;
747 New_Item : Wide_String)
749 NL : constant Natural := New_Item'Length;
751 if Position <= Source.Last - NL + 1 then
752 Source.Reference (Position .. Position + NL - 1) := New_Item;
755 Old : Wide_String_Access := Source.Reference;
757 Source.Reference := new Wide_String'
758 (Wide_Fixed.Overwrite
759 (Source.Reference (1 .. Source.Last), Position, New_Item));
760 Source.Last := Source.Reference'Length;
766 -----------------------
767 -- Realloc_For_Chunk --
768 -----------------------
770 procedure Realloc_For_Chunk
771 (Source : in out Unbounded_Wide_String;
772 Chunk_Size : Natural)
774 Growth_Factor : constant := 32;
775 -- The growth factor controls how much extra space is allocated when
776 -- we have to increase the size of an allocated unbounded string. By
777 -- allocating extra space, we avoid the need to reallocate on every
778 -- append, particularly important when a string is built up by repeated
779 -- append operations of small pieces. This is expressed as a factor so
780 -- 32 means add 1/32 of the length of the string as growth space.
782 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
783 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
784 -- no memory loss as most (all?) malloc implementations are obliged to
785 -- align the returned memory on the maximum alignment as malloc does not
786 -- know the target alignment.
788 S_Length : constant Natural := Source.Reference'Length;
791 if Chunk_Size > S_Length - Source.Last then
793 New_Size : constant Positive :=
794 S_Length + Chunk_Size + (S_Length / Growth_Factor);
796 New_Rounded_Up_Size : constant Positive :=
797 ((New_Size - 1) / Min_Mul_Alloc + 1) *
800 Tmp : constant Wide_String_Access :=
801 new Wide_String (1 .. New_Rounded_Up_Size);
804 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
805 Free (Source.Reference);
806 Source.Reference := Tmp;
809 end Realloc_For_Chunk;
811 ---------------------
812 -- Replace_Element --
813 ---------------------
815 procedure Replace_Element
816 (Source : in out Unbounded_Wide_String;
821 if Index <= Source.Last then
822 Source.Reference (Index) := By;
824 raise Strings.Index_Error;
832 function Replace_Slice
833 (Source : Unbounded_Wide_String;
836 By : Wide_String) return Unbounded_Wide_String
839 return To_Unbounded_Wide_String
840 (Wide_Fixed.Replace_Slice
841 (Source.Reference (1 .. Source.Last), Low, High, By));
844 procedure Replace_Slice
845 (Source : in out Unbounded_Wide_String;
850 Old : Wide_String_Access := Source.Reference;
852 Source.Reference := new Wide_String'
853 (Wide_Fixed.Replace_Slice
854 (Source.Reference (1 .. Source.Last), Low, High, By));
855 Source.Last := Source.Reference'Length;
859 -------------------------------
860 -- Set_Unbounded_Wide_String --
861 -------------------------------
863 procedure Set_Unbounded_Wide_String
864 (Target : out Unbounded_Wide_String;
865 Source : Wide_String)
868 Target.Last := Source'Length;
869 Target.Reference := new Wide_String (1 .. Source'Length);
870 Target.Reference.all := Source;
871 end Set_Unbounded_Wide_String;
878 (Source : Unbounded_Wide_String;
880 High : Natural) return Wide_String
883 -- Note: test of High > Length is in accordance with AI95-00128
885 if Low > Source.Last + 1 or else High > Source.Last then
888 return Source.Reference (Low .. High);
897 (Source : Unbounded_Wide_String;
899 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is
901 return To_Unbounded_Wide_String
902 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
906 (Source : in out Unbounded_Wide_String;
908 Pad : Wide_Character := Wide_Space)
910 Old : Wide_String_Access := Source.Reference;
912 Source.Reference := new Wide_String'
913 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
914 Source.Last := Source.Reference'Length;
918 ------------------------------
919 -- To_Unbounded_Wide_String --
920 ------------------------------
922 function To_Unbounded_Wide_String
923 (Source : Wide_String)
924 return Unbounded_Wide_String
926 Result : Unbounded_Wide_String;
928 Result.Last := Source'Length;
929 Result.Reference := new Wide_String (1 .. Source'Length);
930 Result.Reference.all := Source;
932 end To_Unbounded_Wide_String;
934 function To_Unbounded_Wide_String
935 (Length : Natural) return Unbounded_Wide_String
937 Result : Unbounded_Wide_String;
939 Result.Last := Length;
940 Result.Reference := new Wide_String (1 .. Length);
942 end To_Unbounded_Wide_String;
948 function To_Wide_String
949 (Source : Unbounded_Wide_String)
953 return Source.Reference (1 .. Source.Last);
961 (Source : Unbounded_Wide_String;
962 Mapping : Wide_Maps.Wide_Character_Mapping)
963 return Unbounded_Wide_String
967 To_Unbounded_Wide_String
968 (Wide_Fixed.Translate
969 (Source.Reference (1 .. Source.Last), Mapping));
973 (Source : in out Unbounded_Wide_String;
974 Mapping : Wide_Maps.Wide_Character_Mapping)
977 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
981 (Source : Unbounded_Wide_String;
982 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
983 return Unbounded_Wide_String
987 To_Unbounded_Wide_String
988 (Wide_Fixed.Translate
989 (Source.Reference (1 .. Source.Last), Mapping));
993 (Source : in out Unbounded_Wide_String;
994 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
997 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1005 (Source : Unbounded_Wide_String;
1006 Side : Trim_End) return Unbounded_Wide_String
1010 To_Unbounded_Wide_String
1011 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1015 (Source : in out Unbounded_Wide_String;
1018 Old : Wide_String_Access := Source.Reference;
1022 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1023 Source.Last := Source.Reference'Length;
1028 (Source : Unbounded_Wide_String;
1029 Left : Wide_Maps.Wide_Character_Set;
1030 Right : Wide_Maps.Wide_Character_Set)
1031 return Unbounded_Wide_String
1035 To_Unbounded_Wide_String
1037 (Source.Reference (1 .. Source.Last), Left, Right));
1041 (Source : in out Unbounded_Wide_String;
1042 Left : Wide_Maps.Wide_Character_Set;
1043 Right : Wide_Maps.Wide_Character_Set)
1045 Old : Wide_String_Access := Source.Reference;
1050 (Source.Reference (1 .. Source.Last), Left, Right));
1051 Source.Last := Source.Reference'Length;
1055 ---------------------
1056 -- Unbounded_Slice --
1057 ---------------------
1059 function Unbounded_Slice
1060 (Source : Unbounded_Wide_String;
1062 High : Natural) return Unbounded_Wide_String
1065 if Low > Source.Last + 1 or else High > Source.Last then
1068 return To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1070 end Unbounded_Slice;
1072 procedure Unbounded_Slice
1073 (Source : Unbounded_Wide_String;
1074 Target : out Unbounded_Wide_String;
1079 if Low > Source.Last + 1 or else High > Source.Last then
1083 To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1085 end Unbounded_Slice;
1087 end Ada.Strings.Wide_Unbounded;