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 --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 with Ada
.Strings
.Fixed
;
36 with Ada
.Strings
.Search
;
37 with Ada
.Unchecked_Deallocation
;
39 package body Ada
.Strings
.Unbounded
is
47 function "&" (Left
, Right
: Unbounded_String
) return Unbounded_String
is
48 L_Length
: constant Integer := Left
.Reference
.all'Length;
49 R_Length
: constant Integer := Right
.Reference
.all'Length;
50 Length
: constant Integer := L_Length
+ R_Length
;
51 Result
: Unbounded_String
;
54 Result
.Reference
:= new String (1 .. Length
);
55 Result
.Reference
.all (1 .. L_Length
) := Left
.Reference
.all;
56 Result
.Reference
.all (L_Length
+ 1 .. Length
) := Right
.Reference
.all;
61 (Left
: Unbounded_String
;
63 return Unbounded_String
65 L_Length
: constant Integer := Left
.Reference
.all'Length;
66 Length
: constant Integer := L_Length
+ Right
'Length;
67 Result
: Unbounded_String
;
70 Result
.Reference
:= new String (1 .. Length
);
71 Result
.Reference
.all (1 .. L_Length
) := Left
.Reference
.all;
72 Result
.Reference
.all (L_Length
+ 1 .. Length
) := Right
;
78 Right
: Unbounded_String
)
79 return Unbounded_String
81 R_Length
: constant Integer := Right
.Reference
.all'Length;
82 Length
: constant Integer := Left
'Length + R_Length
;
83 Result
: Unbounded_String
;
86 Result
.Reference
:= new String (1 .. Length
);
87 Result
.Reference
.all (1 .. Left
'Length) := Left
;
88 Result
.Reference
.all (Left
'Length + 1 .. Length
) := Right
.Reference
.all;
93 (Left
: Unbounded_String
;
95 return Unbounded_String
97 Length
: constant Integer := Left
.Reference
.all'Length + 1;
98 Result
: Unbounded_String
;
101 Result
.Reference
:= new String (1 .. Length
);
102 Result
.Reference
.all (1 .. Length
- 1) := Left
.Reference
.all;
103 Result
.Reference
.all (Length
) := Right
;
109 Right
: Unbounded_String
)
110 return Unbounded_String
112 Length
: constant Integer := Right
.Reference
.all'Length + 1;
113 Result
: Unbounded_String
;
116 Result
.Reference
:= new String (1 .. Length
);
117 Result
.Reference
.all (1) := Left
;
118 Result
.Reference
.all (2 .. Length
) := Right
.Reference
.all;
129 return Unbounded_String
131 Result
: Unbounded_String
;
134 Result
.Reference
:= new String (1 .. Left
);
135 for J
in Result
.Reference
'Range loop
136 Result
.Reference
(J
) := Right
;
145 return Unbounded_String
147 Len
: constant Integer := Right
'Length;
148 Result
: Unbounded_String
;
151 Result
.Reference
:= new String (1 .. Left
* Len
);
152 for J
in 1 .. Left
loop
153 Result
.Reference
.all (Len
* J
- Len
+ 1 .. Len
* J
) := Right
;
161 Right
: Unbounded_String
)
162 return Unbounded_String
164 Len
: constant Integer := Right
.Reference
.all'Length;
165 Result
: Unbounded_String
;
168 Result
.Reference
:= new String (1 .. Left
* Len
);
169 for I
in 1 .. Left
loop
170 Result
.Reference
.all (Len
* I
- Len
+ 1 .. Len
* I
) :=
181 function "<" (Left
, Right
: in Unbounded_String
) return Boolean is
183 return Left
.Reference
.all < Right
.Reference
.all;
187 (Left
: in Unbounded_String
;
192 return Left
.Reference
.all < Right
;
197 Right
: in Unbounded_String
)
201 return Left
< Right
.Reference
.all;
208 function "<=" (Left
, Right
: in Unbounded_String
) return Boolean is
210 return Left
.Reference
.all <= Right
.Reference
.all;
214 (Left
: in Unbounded_String
;
219 return Left
.Reference
.all <= Right
;
224 Right
: in Unbounded_String
)
228 return Left
<= Right
.Reference
.all;
235 function "=" (Left
, Right
: in Unbounded_String
) return Boolean is
237 return Left
.Reference
.all = Right
.Reference
.all;
241 (Left
: in Unbounded_String
;
246 return Left
.Reference
.all = Right
;
251 Right
: in Unbounded_String
)
255 return Left
= Right
.Reference
.all;
262 function ">" (Left
, Right
: in Unbounded_String
) return Boolean is
264 return Left
.Reference
.all > Right
.Reference
.all;
268 (Left
: in Unbounded_String
;
273 return Left
.Reference
.all > Right
;
278 Right
: in Unbounded_String
)
282 return Left
> Right
.Reference
.all;
289 function ">=" (Left
, Right
: in Unbounded_String
) return Boolean is
291 return Left
.Reference
.all >= Right
.Reference
.all;
295 (Left
: in Unbounded_String
;
300 return Left
.Reference
.all >= Right
;
305 Right
: in Unbounded_String
)
309 return Left
>= Right
.Reference
.all;
316 procedure Adjust
(Object
: in out Unbounded_String
) is
318 -- Copy string, except we do not copy the statically allocated null
319 -- string, since it can never be deallocated.
321 if Object
.Reference
/= Null_String
'Access then
322 Object
.Reference
:= new String'(Object.Reference.all);
331 (Source : in out Unbounded_String;
332 New_Item : in Unbounded_String)
334 S_Length : constant Integer := Source.Reference.all'Length;
335 Length : constant Integer := S_Length + New_Item.Reference.all'Length;
339 Tmp := new String (1 .. Length);
340 Tmp (1 .. S_Length) := Source.Reference.all;
341 Tmp (S_Length + 1 .. Length) := New_Item.Reference.all;
342 Free (Source.Reference);
343 Source.Reference := Tmp;
347 (Source : in out Unbounded_String;
348 New_Item : in String)
350 S_Length : constant Integer := Source.Reference.all'Length;
351 Length : constant Integer := S_Length + New_Item'Length;
355 Tmp := new String (1 .. Length);
356 Tmp (1 .. S_Length) := Source.Reference.all;
357 Tmp (S_Length + 1 .. Length) := New_Item;
358 Free (Source.Reference);
359 Source.Reference := Tmp;
363 (Source : in out Unbounded_String;
364 New_Item : in Character)
366 S_Length : constant Integer := Source.Reference.all'Length;
367 Length : constant Integer := S_Length + 1;
371 Tmp := new String (1 .. Length);
372 Tmp (1 .. S_Length) := Source.Reference.all;
373 Tmp (S_Length + 1) := New_Item;
374 Free (Source.Reference);
375 Source.Reference := Tmp;
383 (Source : Unbounded_String;
385 Mapping : Maps.Character_Mapping := Maps.Identity)
389 return Search.Count (Source.Reference.all, Pattern, Mapping);
393 (Source : in Unbounded_String;
395 Mapping : in Maps.Character_Mapping_Function)
399 return Search.Count (Source.Reference.all, Pattern, Mapping);
403 (Source : Unbounded_String;
404 Set : Maps.Character_Set)
408 return Search.Count (Source.Reference.all, Set);
416 (Source : Unbounded_String;
419 return Unbounded_String
424 (Fixed.Delete (Source.Reference.all, From, Through));
428 (Source : in out Unbounded_String;
430 Through : in Natural)
432 Old : String_Access := Source.Reference;
436 new String' (Fixed
.Delete
(Old
.all, From
, Through
));
445 (Source
: Unbounded_String
;
450 if Index
<= Source
.Reference
.all'Last then
451 return Source
.Reference
.all (Index
);
453 raise Strings
.Index_Error
;
461 procedure Finalize
(Object
: in out Unbounded_String
) is
462 procedure Deallocate
is
463 new Ada
.Unchecked_Deallocation
(String, String_Access
);
466 -- Note: Don't try to free statically allocated null string
468 if Object
.Reference
/= Null_String
'Access then
469 Deallocate
(Object
.Reference
);
470 Object
.Reference
:= Null_Unbounded_String
.Reference
;
479 (Source
: Unbounded_String
;
480 Set
: Maps
.Character_Set
;
481 Test
: Strings
.Membership
;
482 First
: out Positive;
486 Search
.Find_Token
(Source
.Reference
.all, Set
, Test
, First
, Last
);
493 procedure Free
(X
: in out String_Access
) is
494 procedure Deallocate
is
495 new Ada
.Unchecked_Deallocation
(String, String_Access
);
498 -- Note: Don't try to free statically allocated null string
500 if X
/= Null_Unbounded_String
.Reference
then
510 (Source
: Unbounded_String
;
512 Pad
: Character := Space
)
513 return Unbounded_String
517 To_Unbounded_String
(Fixed
.Head
(Source
.Reference
.all, Count
, Pad
));
521 (Source
: in out Unbounded_String
;
523 Pad
: in Character := Space
)
525 Old
: String_Access
:= Source
.Reference
;
528 Source
.Reference
:= new String'(Fixed.Head (Old.all, Count, Pad));
537 (Source : Unbounded_String;
539 Going : Strings.Direction := Strings.Forward;
540 Mapping : Maps.Character_Mapping := Maps.Identity)
544 return Search.Index (Source.Reference.all, Pattern, Going, Mapping);
548 (Source : in Unbounded_String;
550 Going : in Direction := Forward;
551 Mapping : in Maps.Character_Mapping_Function)
555 return Search.Index (Source.Reference.all, Pattern, Going, Mapping);
559 (Source : Unbounded_String;
560 Set : Maps.Character_Set;
561 Test : Strings.Membership := Strings.Inside;
562 Going : Strings.Direction := Strings.Forward)
566 return Search.Index (Source.Reference.all, Set, Test, Going);
569 function Index_Non_Blank
570 (Source : Unbounded_String;
571 Going : Strings.Direction := Strings.Forward)
575 return Search.Index_Non_Blank (Source.Reference.all, Going);
582 procedure Initialize (Object : in out Unbounded_String) is
584 Object.Reference := Null_Unbounded_String.Reference;
592 (Source : Unbounded_String;
595 return Unbounded_String
600 (Fixed.Insert (Source.Reference.all, Before, New_Item));
604 (Source : in out Unbounded_String;
605 Before : in Positive;
606 New_Item : in String)
608 Old : String_Access := Source.Reference;
612 new String' (Fixed
.Insert
(Source
.Reference
.all, Before
, New_Item
));
620 function Length
(Source
: Unbounded_String
) return Natural is
622 return Source
.Reference
.all'Length;
630 (Source
: Unbounded_String
;
633 return Unbounded_String
is
636 return To_Unbounded_String
637 (Fixed
.Overwrite
(Source
.Reference
.all, Position
, New_Item
));
641 (Source
: in out Unbounded_String
;
642 Position
: in Positive;
643 New_Item
: in String)
645 NL
: constant Integer := New_Item
'Length;
648 if Position
<= Source
.Reference
'Length - NL
+ 1 then
649 Source
.Reference
(Position
.. Position
+ NL
- 1) := New_Item
;
653 Old
: String_Access
:= Source
.Reference
;
656 Source
.Reference
:= new
657 String'(Fixed.Overwrite (Old.all, Position, New_Item));
663 ---------------------
664 -- Replace_Element --
665 ---------------------
667 procedure Replace_Element
668 (Source : in out Unbounded_String;
673 if Index <= Source.Reference.all'Last then
674 Source.Reference.all (Index) := By;
676 raise Strings.Index_Error;
684 function Replace_Slice
685 (Source : Unbounded_String;
689 return Unbounded_String
694 (Fixed.Replace_Slice (Source.Reference.all, Low, High, By));
697 procedure Replace_Slice
698 (Source : in out Unbounded_String;
703 Old : String_Access := Source.Reference;
707 new String'(Fixed
.Replace_Slice
(Old
.all, Low
, High
, By
));
716 (Source
: Unbounded_String
;
721 Length
: constant Natural := Source
.Reference
'Length;
724 -- Note: test of High > Length is in accordance with AI95-00128
726 if Low
> Length
+ 1 or else High
> Length
then
729 return Source
.Reference
.all (Low
.. High
);
738 (Source
: Unbounded_String
;
740 Pad
: Character := Space
)
741 return Unbounded_String
is
745 To_Unbounded_String
(Fixed
.Tail
(Source
.Reference
.all, Count
, Pad
));
749 (Source
: in out Unbounded_String
;
751 Pad
: in Character := Space
)
753 Old
: String_Access
:= Source
.Reference
;
756 Source
.Reference
:= new String'(Fixed.Tail (Old.all, Count, Pad));
764 function To_String (Source : Unbounded_String) return String is
766 return Source.Reference.all;
769 -------------------------
770 -- To_Unbounded_String --
771 -------------------------
773 function To_Unbounded_String (Source : String) return Unbounded_String is
774 Result : Unbounded_String;
777 Result.Reference := new String (1 .. Source'Length);
778 Result.Reference.all := Source;
780 end To_Unbounded_String;
782 function To_Unbounded_String
783 (Length : in Natural)
784 return Unbounded_String
786 Result : Unbounded_String;
789 Result.Reference := new String (1 .. Length);
791 end To_Unbounded_String;
798 (Source : Unbounded_String;
799 Mapping : Maps.Character_Mapping)
800 return Unbounded_String
804 To_Unbounded_String (Fixed.Translate (Source.Reference.all, Mapping));
808 (Source : in out Unbounded_String;
809 Mapping : Maps.Character_Mapping)
812 Fixed.Translate (Source.Reference.all, Mapping);
816 (Source : in Unbounded_String;
817 Mapping : in Maps.Character_Mapping_Function)
818 return Unbounded_String
822 To_Unbounded_String (Fixed.Translate (Source.Reference.all, Mapping));
826 (Source : in out Unbounded_String;
827 Mapping : in Maps.Character_Mapping_Function)
830 Fixed.Translate (Source.Reference.all, Mapping);
838 (Source : in Unbounded_String;
840 return Unbounded_String
843 return To_Unbounded_String (Fixed.Trim (Source.Reference.all, Side));
847 (Source : in out Unbounded_String;
850 Old : String_Access := Source.Reference;
853 Source.Reference := new String'(Fixed
.Trim
(Old
.all, Side
));
858 (Source
: in Unbounded_String
;
859 Left
: in Maps
.Character_Set
;
860 Right
: in Maps
.Character_Set
)
861 return Unbounded_String
865 To_Unbounded_String
(Fixed
.Trim
(Source
.Reference
.all, Left
, Right
));
869 (Source
: in out Unbounded_String
;
870 Left
: in Maps
.Character_Set
;
871 Right
: in Maps
.Character_Set
)
873 Old
: String_Access
:= Source
.Reference
;
876 Source
.Reference
:= new String'(Fixed.Trim (Old.all, Left, Right));
880 end Ada.Strings.Unbounded;