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-2001 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
46 function "&" (Left, Right : Unbounded_String) return Unbounded_String is
47 L_Length : constant Integer := Left.Reference.all'Length;
48 R_Length : constant Integer := Right.Reference.all'Length;
49 Length : constant Integer := L_Length + R_Length;
50 Result : Unbounded_String;
53 Result.Reference := new String (1 .. Length);
54 Result.Reference.all (1 .. L_Length) := Left.Reference.all;
55 Result.Reference.all (L_Length + 1 .. Length) := Right.Reference.all;
60 (Left : Unbounded_String;
62 return Unbounded_String
64 L_Length : constant Integer := Left.Reference.all'Length;
65 Length : constant Integer := L_Length + Right'Length;
66 Result : Unbounded_String;
69 Result.Reference := new String (1 .. Length);
70 Result.Reference.all (1 .. L_Length) := Left.Reference.all;
71 Result.Reference.all (L_Length + 1 .. Length) := Right;
77 Right : Unbounded_String)
78 return Unbounded_String
80 R_Length : constant Integer := Right.Reference.all'Length;
81 Length : constant Integer := Left'Length + R_Length;
82 Result : Unbounded_String;
85 Result.Reference := new String (1 .. Length);
86 Result.Reference.all (1 .. Left'Length) := Left;
87 Result.Reference.all (Left'Length + 1 .. Length) := Right.Reference.all;
92 (Left : Unbounded_String;
94 return Unbounded_String
96 Length : constant Integer := Left.Reference.all'Length + 1;
97 Result : Unbounded_String;
100 Result.Reference := new String (1 .. Length);
101 Result.Reference.all (1 .. Length - 1) := Left.Reference.all;
102 Result.Reference.all (Length) := Right;
108 Right : Unbounded_String)
109 return Unbounded_String
111 Length : constant Integer := Right.Reference.all'Length + 1;
112 Result : Unbounded_String;
115 Result.Reference := new String (1 .. Length);
116 Result.Reference.all (1) := Left;
117 Result.Reference.all (2 .. Length) := Right.Reference.all;
128 return Unbounded_String
130 Result : Unbounded_String;
133 Result.Reference := new String (1 .. Left);
134 for J in Result.Reference'Range loop
135 Result.Reference (J) := Right;
144 return Unbounded_String
146 Len : constant Integer := Right'Length;
147 Result : Unbounded_String;
150 Result.Reference := new String (1 .. Left * Len);
151 for J in 1 .. Left loop
152 Result.Reference.all (Len * J - Len + 1 .. Len * J) := Right;
160 Right : Unbounded_String)
161 return Unbounded_String
163 Len : constant Integer := Right.Reference.all'Length;
164 Result : Unbounded_String;
167 Result.Reference := new String (1 .. Left * Len);
168 for I in 1 .. Left loop
169 Result.Reference.all (Len * I - Len + 1 .. Len * I) :=
180 function "<" (Left, Right : in Unbounded_String) return Boolean is
182 return Left.Reference.all < Right.Reference.all;
186 (Left : in Unbounded_String;
191 return Left.Reference.all < Right;
196 Right : in Unbounded_String)
200 return Left < Right.Reference.all;
207 function "<=" (Left, Right : in Unbounded_String) return Boolean is
209 return Left.Reference.all <= Right.Reference.all;
213 (Left : in Unbounded_String;
218 return Left.Reference.all <= Right;
223 Right : in Unbounded_String)
227 return Left <= Right.Reference.all;
234 function "=" (Left, Right : in Unbounded_String) return Boolean is
236 return Left.Reference.all = Right.Reference.all;
240 (Left : in Unbounded_String;
245 return Left.Reference.all = Right;
250 Right : in Unbounded_String)
254 return Left = Right.Reference.all;
261 function ">" (Left, Right : in Unbounded_String) return Boolean is
263 return Left.Reference.all > Right.Reference.all;
267 (Left : in Unbounded_String;
272 return Left.Reference.all > Right;
277 Right : in Unbounded_String)
281 return Left > Right.Reference.all;
288 function ">=" (Left, Right : in Unbounded_String) return Boolean is
290 return Left.Reference.all >= Right.Reference.all;
294 (Left : in Unbounded_String;
299 return Left.Reference.all >= Right;
304 Right : in Unbounded_String)
308 return Left >= Right.Reference.all;
315 procedure Adjust (Object : in out Unbounded_String) is
317 -- Copy string, except we do not copy the statically allocated null
318 -- string, since it can never be deallocated.
320 if Object.Reference /= Null_String'Access then
321 Object.Reference := new String'(Object.Reference.all);
330 (Source : in out Unbounded_String;
331 New_Item : in Unbounded_String)
333 S_Length : constant Integer := Source.Reference.all'Length;
334 Length : constant Integer := S_Length + New_Item.Reference.all'Length;
338 Tmp := new String (1 .. Length);
339 Tmp (1 .. S_Length) := Source.Reference.all;
340 Tmp (S_Length + 1 .. Length) := New_Item.Reference.all;
341 Free (Source.Reference);
342 Source.Reference := Tmp;
346 (Source : in out Unbounded_String;
347 New_Item : in String)
349 S_Length : constant Integer := Source.Reference.all'Length;
350 Length : constant Integer := S_Length + New_Item'Length;
354 Tmp := new String (1 .. Length);
355 Tmp (1 .. S_Length) := Source.Reference.all;
356 Tmp (S_Length + 1 .. Length) := New_Item;
357 Free (Source.Reference);
358 Source.Reference := Tmp;
362 (Source : in out Unbounded_String;
363 New_Item : in Character)
365 S_Length : constant Integer := Source.Reference.all'Length;
366 Length : constant Integer := S_Length + 1;
370 Tmp := new String (1 .. Length);
371 Tmp (1 .. S_Length) := Source.Reference.all;
372 Tmp (S_Length + 1) := New_Item;
373 Free (Source.Reference);
374 Source.Reference := Tmp;
382 (Source : Unbounded_String;
384 Mapping : Maps.Character_Mapping := Maps.Identity)
388 return Search.Count (Source.Reference.all, Pattern, Mapping);
392 (Source : in Unbounded_String;
394 Mapping : in Maps.Character_Mapping_Function)
398 return Search.Count (Source.Reference.all, Pattern, Mapping);
402 (Source : Unbounded_String;
403 Set : Maps.Character_Set)
407 return Search.Count (Source.Reference.all, Set);
415 (Source : Unbounded_String;
418 return Unbounded_String
423 (Fixed.Delete (Source.Reference.all, From, Through));
427 (Source : in out Unbounded_String;
429 Through : in Natural)
431 Old : String_Access := Source.Reference;
435 new String' (Fixed.Delete (Old.all, From, Through));
444 (Source : Unbounded_String;
449 if Index <= Source.Reference.all'Last then
450 return Source.Reference.all (Index);
452 raise Strings.Index_Error;
460 procedure Finalize (Object : in out Unbounded_String) is
461 procedure Deallocate is
462 new Ada.Unchecked_Deallocation (String, String_Access);
465 -- Note: Don't try to free statically allocated null string
467 if Object.Reference /= Null_String'Access then
468 Deallocate (Object.Reference);
469 Object.Reference := Null_Unbounded_String.Reference;
478 (Source : Unbounded_String;
479 Set : Maps.Character_Set;
480 Test : Strings.Membership;
481 First : out Positive;
485 Search.Find_Token (Source.Reference.all, Set, Test, First, Last);
492 procedure Free (X : in out String_Access) is
493 procedure Deallocate is
494 new Ada.Unchecked_Deallocation (String, String_Access);
497 -- Note: Don't try to free statically allocated null string
499 if X /= Null_Unbounded_String.Reference then
509 (Source : Unbounded_String;
511 Pad : Character := Space)
512 return Unbounded_String
516 To_Unbounded_String (Fixed.Head (Source.Reference.all, Count, Pad));
520 (Source : in out Unbounded_String;
522 Pad : in Character := Space)
524 Old : String_Access := Source.Reference;
527 Source.Reference := new String'(Fixed.Head (Old.all, Count, Pad));
536 (Source : Unbounded_String;
538 Going : Strings.Direction := Strings.Forward;
539 Mapping : Maps.Character_Mapping := Maps.Identity)
543 return Search.Index (Source.Reference.all, Pattern, Going, Mapping);
547 (Source : in Unbounded_String;
549 Going : in Direction := Forward;
550 Mapping : in Maps.Character_Mapping_Function)
554 return Search.Index (Source.Reference.all, Pattern, Going, Mapping);
558 (Source : Unbounded_String;
559 Set : Maps.Character_Set;
560 Test : Strings.Membership := Strings.Inside;
561 Going : Strings.Direction := Strings.Forward)
565 return Search.Index (Source.Reference.all, Set, Test, Going);
568 function Index_Non_Blank
569 (Source : Unbounded_String;
570 Going : Strings.Direction := Strings.Forward)
574 return Search.Index_Non_Blank (Source.Reference.all, Going);
581 procedure Initialize (Object : in out Unbounded_String) is
583 Object.Reference := Null_Unbounded_String.Reference;
591 (Source : Unbounded_String;
594 return Unbounded_String
599 (Fixed.Insert (Source.Reference.all, Before, New_Item));
603 (Source : in out Unbounded_String;
604 Before : in Positive;
605 New_Item : in String)
607 Old : String_Access := Source.Reference;
611 new String' (Fixed.Insert (Source.Reference.all, Before, New_Item));
619 function Length (Source : Unbounded_String) return Natural is
621 return Source.Reference.all'Length;
629 (Source : Unbounded_String;
632 return Unbounded_String is
635 return To_Unbounded_String
636 (Fixed.Overwrite (Source.Reference.all, Position, New_Item));
640 (Source : in out Unbounded_String;
641 Position : in Positive;
642 New_Item : in String)
644 NL : constant Integer := New_Item'Length;
647 if Position <= Source.Reference'Length - NL + 1 then
648 Source.Reference (Position .. Position + NL - 1) := New_Item;
652 Old : String_Access := Source.Reference;
655 Source.Reference := new
656 String'(Fixed.Overwrite (Old.all, Position, New_Item));
662 ---------------------
663 -- Replace_Element --
664 ---------------------
666 procedure Replace_Element
667 (Source : in out Unbounded_String;
672 if Index <= Source.Reference.all'Last then
673 Source.Reference.all (Index) := By;
675 raise Strings.Index_Error;
683 function Replace_Slice
684 (Source : Unbounded_String;
688 return Unbounded_String
693 (Fixed.Replace_Slice (Source.Reference.all, Low, High, By));
696 procedure Replace_Slice
697 (Source : in out Unbounded_String;
702 Old : String_Access := Source.Reference;
706 new String'(Fixed.Replace_Slice (Old.all, Low, High, By));
715 (Source : Unbounded_String;
720 Length : constant Natural := Source.Reference'Length;
723 -- Note: test of High > Length is in accordance with AI95-00128
725 if Low > Length + 1 or else High > Length then
728 return Source.Reference.all (Low .. High);
737 (Source : Unbounded_String;
739 Pad : Character := Space)
740 return Unbounded_String is
744 To_Unbounded_String (Fixed.Tail (Source.Reference.all, Count, Pad));
748 (Source : in out Unbounded_String;
750 Pad : in Character := Space)
752 Old : String_Access := Source.Reference;
755 Source.Reference := new String'(Fixed.Tail (Old.all, Count, Pad));
763 function To_String (Source : Unbounded_String) return String is
765 return Source.Reference.all;
768 -------------------------
769 -- To_Unbounded_String --
770 -------------------------
772 function To_Unbounded_String (Source : String) return Unbounded_String is
773 Result : Unbounded_String;
776 Result.Reference := new String (1 .. Source'Length);
777 Result.Reference.all := Source;
779 end To_Unbounded_String;
781 function To_Unbounded_String
782 (Length : in Natural)
783 return Unbounded_String
785 Result : Unbounded_String;
788 Result.Reference := new String (1 .. Length);
790 end To_Unbounded_String;
797 (Source : Unbounded_String;
798 Mapping : Maps.Character_Mapping)
799 return Unbounded_String
803 To_Unbounded_String (Fixed.Translate (Source.Reference.all, Mapping));
807 (Source : in out Unbounded_String;
808 Mapping : Maps.Character_Mapping)
811 Fixed.Translate (Source.Reference.all, Mapping);
815 (Source : in Unbounded_String;
816 Mapping : in Maps.Character_Mapping_Function)
817 return Unbounded_String
821 To_Unbounded_String (Fixed.Translate (Source.Reference.all, Mapping));
825 (Source : in out Unbounded_String;
826 Mapping : in Maps.Character_Mapping_Function)
829 Fixed.Translate (Source.Reference.all, Mapping);
837 (Source : in Unbounded_String;
839 return Unbounded_String
842 return To_Unbounded_String (Fixed.Trim (Source.Reference.all, Side));
846 (Source : in out Unbounded_String;
849 Old : String_Access := Source.Reference;
852 Source.Reference := new String'(Fixed.Trim (Old.all, Side));
857 (Source : in Unbounded_String;
858 Left : in Maps.Character_Set;
859 Right : in Maps.Character_Set)
860 return Unbounded_String
864 To_Unbounded_String (Fixed.Trim (Source.Reference.all, Left, Right));
868 (Source : in out Unbounded_String;
869 Left : in Maps.Character_Set;
870 Right : in Maps.Character_Set)
872 Old : String_Access := Source.Reference;
875 Source.Reference := new String'(Fixed.Trim (Old.all, Left, Right));
879 end Ada.Strings.Unbounded;