File : a-strunb.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . U N B O U N D E D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Strings.Fixed;
33 with Ada.Strings.Search;
34 with Ada.Unchecked_Deallocation;
35
36 package body Ada.Strings.Unbounded is
37
38 use Ada.Finalization;
39
40 ---------
41 -- "&" --
42 ---------
43
44 function "&"
45 (Left : Unbounded_String;
46 Right : Unbounded_String) return Unbounded_String
47 is
48 L_Length : constant Natural := Left.Last;
49 R_Length : constant Natural := Right.Last;
50 Result : Unbounded_String;
51
52 begin
53 Result.Last := L_Length + R_Length;
54
55 Result.Reference := new String (1 .. Result.Last);
56
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);
61
62 return Result;
63 end "&";
64
65 function "&"
66 (Left : Unbounded_String;
67 Right : String) return Unbounded_String
68 is
69 L_Length : constant Natural := Left.Last;
70 Result : Unbounded_String;
71
72 begin
73 Result.Last := L_Length + Right'Length;
74
75 Result.Reference := new String (1 .. Result.Last);
76
77 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
78 Result.Reference (L_Length + 1 .. Result.Last) := Right;
79
80 return Result;
81 end "&";
82
83 function "&"
84 (Left : String;
85 Right : Unbounded_String) return Unbounded_String
86 is
87 R_Length : constant Natural := Right.Last;
88 Result : Unbounded_String;
89
90 begin
91 Result.Last := Left'Length + R_Length;
92
93 Result.Reference := new String (1 .. Result.Last);
94
95 Result.Reference (1 .. Left'Length) := Left;
96 Result.Reference (Left'Length + 1 .. Result.Last) :=
97 Right.Reference (1 .. Right.Last);
98
99 return Result;
100 end "&";
101
102 function "&"
103 (Left : Unbounded_String;
104 Right : Character) return Unbounded_String
105 is
106 Result : Unbounded_String;
107
108 begin
109 Result.Last := Left.Last + 1;
110
111 Result.Reference := new String (1 .. Result.Last);
112
113 Result.Reference (1 .. Result.Last - 1) :=
114 Left.Reference (1 .. Left.Last);
115 Result.Reference (Result.Last) := Right;
116
117 return Result;
118 end "&";
119
120 function "&"
121 (Left : Character;
122 Right : Unbounded_String) return Unbounded_String
123 is
124 Result : Unbounded_String;
125
126 begin
127 Result.Last := Right.Last + 1;
128
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);
133 return Result;
134 end "&";
135
136 ---------
137 -- "*" --
138 ---------
139
140 function "*"
141 (Left : Natural;
142 Right : Character) return Unbounded_String
143 is
144 Result : Unbounded_String;
145
146 begin
147 Result.Last := Left;
148
149 Result.Reference := new String (1 .. Left);
150 for J in Result.Reference'Range loop
151 Result.Reference (J) := Right;
152 end loop;
153
154 return Result;
155 end "*";
156
157 function "*"
158 (Left : Natural;
159 Right : String) return Unbounded_String
160 is
161 Len : constant Natural := Right'Length;
162 K : Positive;
163 Result : Unbounded_String;
164
165 begin
166 Result.Last := Left * Len;
167
168 Result.Reference := new String (1 .. Result.Last);
169
170 K := 1;
171 for J in 1 .. Left loop
172 Result.Reference (K .. K + Len - 1) := Right;
173 K := K + Len;
174 end loop;
175
176 return Result;
177 end "*";
178
179 function "*"
180 (Left : Natural;
181 Right : Unbounded_String) return Unbounded_String
182 is
183 Len : constant Natural := Right.Last;
184 K : Positive;
185 Result : Unbounded_String;
186
187 begin
188 Result.Last := Left * Len;
189
190 Result.Reference := new String (1 .. Result.Last);
191
192 K := 1;
193 for J in 1 .. Left loop
194 Result.Reference (K .. K + Len - 1) :=
195 Right.Reference (1 .. Right.Last);
196 K := K + Len;
197 end loop;
198
199 return Result;
200 end "*";
201
202 ---------
203 -- "<" --
204 ---------
205
206 function "<"
207 (Left : Unbounded_String;
208 Right : Unbounded_String) return Boolean
209 is
210 begin
211 return
212 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
213 end "<";
214
215 function "<"
216 (Left : Unbounded_String;
217 Right : String) return Boolean
218 is
219 begin
220 return Left.Reference (1 .. Left.Last) < Right;
221 end "<";
222
223 function "<"
224 (Left : String;
225 Right : Unbounded_String) return Boolean
226 is
227 begin
228 return Left < Right.Reference (1 .. Right.Last);
229 end "<";
230
231 ----------
232 -- "<=" --
233 ----------
234
235 function "<="
236 (Left : Unbounded_String;
237 Right : Unbounded_String) return Boolean
238 is
239 begin
240 return
241 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
242 end "<=";
243
244 function "<="
245 (Left : Unbounded_String;
246 Right : String) return Boolean
247 is
248 begin
249 return Left.Reference (1 .. Left.Last) <= Right;
250 end "<=";
251
252 function "<="
253 (Left : String;
254 Right : Unbounded_String) return Boolean
255 is
256 begin
257 return Left <= Right.Reference (1 .. Right.Last);
258 end "<=";
259
260 ---------
261 -- "=" --
262 ---------
263
264 function "="
265 (Left : Unbounded_String;
266 Right : Unbounded_String) return Boolean
267 is
268 begin
269 return
270 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
271 end "=";
272
273 function "="
274 (Left : Unbounded_String;
275 Right : String) return Boolean
276 is
277 begin
278 return Left.Reference (1 .. Left.Last) = Right;
279 end "=";
280
281 function "="
282 (Left : String;
283 Right : Unbounded_String) return Boolean
284 is
285 begin
286 return Left = Right.Reference (1 .. Right.Last);
287 end "=";
288
289 ---------
290 -- ">" --
291 ---------
292
293 function ">"
294 (Left : Unbounded_String;
295 Right : Unbounded_String) return Boolean
296 is
297 begin
298 return
299 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
300 end ">";
301
302 function ">"
303 (Left : Unbounded_String;
304 Right : String) return Boolean
305 is
306 begin
307 return Left.Reference (1 .. Left.Last) > Right;
308 end ">";
309
310 function ">"
311 (Left : String;
312 Right : Unbounded_String) return Boolean
313 is
314 begin
315 return Left > Right.Reference (1 .. Right.Last);
316 end ">";
317
318 ----------
319 -- ">=" --
320 ----------
321
322 function ">="
323 (Left : Unbounded_String;
324 Right : Unbounded_String) return Boolean
325 is
326 begin
327 return
328 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
329 end ">=";
330
331 function ">="
332 (Left : Unbounded_String;
333 Right : String) return Boolean
334 is
335 begin
336 return Left.Reference (1 .. Left.Last) >= Right;
337 end ">=";
338
339 function ">="
340 (Left : String;
341 Right : Unbounded_String) return Boolean
342 is
343 begin
344 return Left >= Right.Reference (1 .. Right.Last);
345 end ">=";
346
347 ------------
348 -- Adjust --
349 ------------
350
351 procedure Adjust (Object : in out Unbounded_String) is
352 begin
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.
356
357 if Object.Reference /= Null_String'Access then
358 Object.Reference := new String'(Object.Reference (1 .. Object.Last));
359 end if;
360 end Adjust;
361
362 ------------
363 -- Append --
364 ------------
365
366 procedure Append
367 (Source : in out Unbounded_String;
368 New_Item : Unbounded_String)
369 is
370 begin
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;
375 end Append;
376
377 procedure Append
378 (Source : in out Unbounded_String;
379 New_Item : String)
380 is
381 begin
382 Realloc_For_Chunk (Source, New_Item'Length);
383 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
384 New_Item;
385 Source.Last := Source.Last + New_Item'Length;
386 end Append;
387
388 procedure Append
389 (Source : in out Unbounded_String;
390 New_Item : Character)
391 is
392 begin
393 Realloc_For_Chunk (Source, 1);
394 Source.Reference (Source.Last + 1) := New_Item;
395 Source.Last := Source.Last + 1;
396 end Append;
397
398 -----------
399 -- Count --
400 -----------
401
402 function Count
403 (Source : Unbounded_String;
404 Pattern : String;
405 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
406 is
407 begin
408 return
409 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
410 end Count;
411
412 function Count
413 (Source : Unbounded_String;
414 Pattern : String;
415 Mapping : Maps.Character_Mapping_Function) return Natural
416 is
417 begin
418 return
419 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
420 end Count;
421
422 function Count
423 (Source : Unbounded_String;
424 Set : Maps.Character_Set) return Natural
425 is
426 begin
427 return Search.Count (Source.Reference (1 .. Source.Last), Set);
428 end Count;
429
430 ------------
431 -- Delete --
432 ------------
433
434 function Delete
435 (Source : Unbounded_String;
436 From : Positive;
437 Through : Natural) return Unbounded_String
438 is
439 begin
440 return
441 To_Unbounded_String
442 (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
443 end Delete;
444
445 procedure Delete
446 (Source : in out Unbounded_String;
447 From : Positive;
448 Through : Natural)
449 is
450 begin
451 if From > Through then
452 null;
453
454 elsif From < Source.Reference'First or else Through > Source.Last then
455 raise Index_Error;
456
457 else
458 declare
459 Len : constant Natural := Through - From + 1;
460
461 begin
462 Source.Reference (From .. Source.Last - Len) :=
463 Source.Reference (Through + 1 .. Source.Last);
464 Source.Last := Source.Last - Len;
465 end;
466 end if;
467 end Delete;
468
469 -------------
470 -- Element --
471 -------------
472
473 function Element
474 (Source : Unbounded_String;
475 Index : Positive) return Character
476 is
477 begin
478 if Index <= Source.Last then
479 return Source.Reference (Index);
480 else
481 raise Strings.Index_Error;
482 end if;
483 end Element;
484
485 --------------
486 -- Finalize --
487 --------------
488
489 procedure Finalize (Object : in out Unbounded_String) is
490 procedure Deallocate is
491 new Ada.Unchecked_Deallocation (String, String_Access);
492
493 begin
494 -- Note: Don't try to free statically allocated null string
495
496 if Object.Reference /= Null_String'Access then
497 Deallocate (Object.Reference);
498 Object.Reference := Null_Unbounded_String.Reference;
499 Object.Last := 0;
500 end if;
501 end Finalize;
502
503 ----------------
504 -- Find_Token --
505 ----------------
506
507 procedure Find_Token
508 (Source : Unbounded_String;
509 Set : Maps.Character_Set;
510 From : Positive;
511 Test : Strings.Membership;
512 First : out Positive;
513 Last : out Natural)
514 is
515 begin
516 Search.Find_Token
517 (Source.Reference (From .. Source.Last), Set, Test, First, Last);
518 end Find_Token;
519
520 procedure Find_Token
521 (Source : Unbounded_String;
522 Set : Maps.Character_Set;
523 Test : Strings.Membership;
524 First : out Positive;
525 Last : out Natural)
526 is
527 begin
528 Search.Find_Token
529 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
530 end Find_Token;
531
532 ----------
533 -- Free --
534 ----------
535
536 procedure Free (X : in out String_Access) is
537 procedure Deallocate is
538 new Ada.Unchecked_Deallocation (String, String_Access);
539
540 begin
541 -- Note: Do not try to free statically allocated null string
542
543 if X /= Null_Unbounded_String.Reference then
544 Deallocate (X);
545 end if;
546 end Free;
547
548 ----------
549 -- Head --
550 ----------
551
552 function Head
553 (Source : Unbounded_String;
554 Count : Natural;
555 Pad : Character := Space) return Unbounded_String
556 is
557 begin
558 return To_Unbounded_String
559 (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
560 end Head;
561
562 procedure Head
563 (Source : in out Unbounded_String;
564 Count : Natural;
565 Pad : Character := Space)
566 is
567 Old : String_Access := Source.Reference;
568 begin
569 Source.Reference :=
570 new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
571 Count, Pad));
572 Source.Last := Source.Reference'Length;
573 Free (Old);
574 end Head;
575
576 -----------
577 -- Index --
578 -----------
579
580 function Index
581 (Source : Unbounded_String;
582 Pattern : String;
583 Going : Strings.Direction := Strings.Forward;
584 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
585 is
586 begin
587 return Search.Index
588 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
589 end Index;
590
591 function Index
592 (Source : Unbounded_String;
593 Pattern : String;
594 Going : Direction := Forward;
595 Mapping : Maps.Character_Mapping_Function) return Natural
596 is
597 begin
598 return Search.Index
599 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
600 end Index;
601
602 function Index
603 (Source : Unbounded_String;
604 Set : Maps.Character_Set;
605 Test : Strings.Membership := Strings.Inside;
606 Going : Strings.Direction := Strings.Forward) return Natural
607 is
608 begin
609 return Search.Index
610 (Source.Reference (1 .. Source.Last), Set, Test, Going);
611 end Index;
612
613 function Index
614 (Source : Unbounded_String;
615 Pattern : String;
616 From : Positive;
617 Going : Direction := Forward;
618 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
619 is
620 begin
621 return Search.Index
622 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
623 end Index;
624
625 function Index
626 (Source : Unbounded_String;
627 Pattern : String;
628 From : Positive;
629 Going : Direction := Forward;
630 Mapping : Maps.Character_Mapping_Function) return Natural
631 is
632 begin
633 return Search.Index
634 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
635 end Index;
636
637 function Index
638 (Source : Unbounded_String;
639 Set : Maps.Character_Set;
640 From : Positive;
641 Test : Membership := Inside;
642 Going : Direction := Forward) return Natural
643 is
644 begin
645 return Search.Index
646 (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
647 end Index;
648
649 function Index_Non_Blank
650 (Source : Unbounded_String;
651 Going : Strings.Direction := Strings.Forward) return Natural
652 is
653 begin
654 return
655 Search.Index_Non_Blank
656 (Source.Reference (1 .. Source.Last), Going);
657 end Index_Non_Blank;
658
659 function Index_Non_Blank
660 (Source : Unbounded_String;
661 From : Positive;
662 Going : Direction := Forward) return Natural
663 is
664 begin
665 return
666 Search.Index_Non_Blank
667 (Source.Reference (1 .. Source.Last), From, Going);
668 end Index_Non_Blank;
669
670 ----------------
671 -- Initialize --
672 ----------------
673
674 procedure Initialize (Object : in out Unbounded_String) is
675 begin
676 Object.Reference := Null_Unbounded_String.Reference;
677 Object.Last := 0;
678 end Initialize;
679
680 ------------
681 -- Insert --
682 ------------
683
684 function Insert
685 (Source : Unbounded_String;
686 Before : Positive;
687 New_Item : String) return Unbounded_String
688 is
689 begin
690 return To_Unbounded_String
691 (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
692 end Insert;
693
694 procedure Insert
695 (Source : in out Unbounded_String;
696 Before : Positive;
697 New_Item : String)
698 is
699 begin
700 if Before not in Source.Reference'First .. Source.Last + 1 then
701 raise Index_Error;
702 end if;
703
704 Realloc_For_Chunk (Source, New_Item'Length);
705
706 Source.Reference
707 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
708 Source.Reference (Before .. Source.Last);
709
710 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
711 Source.Last := Source.Last + New_Item'Length;
712 end Insert;
713
714 ------------
715 -- Length --
716 ------------
717
718 function Length (Source : Unbounded_String) return Natural is
719 begin
720 return Source.Last;
721 end Length;
722
723 ---------------
724 -- Overwrite --
725 ---------------
726
727 function Overwrite
728 (Source : Unbounded_String;
729 Position : Positive;
730 New_Item : String) return Unbounded_String
731 is
732 begin
733 return To_Unbounded_String
734 (Fixed.Overwrite
735 (Source.Reference (1 .. Source.Last), Position, New_Item));
736 end Overwrite;
737
738 procedure Overwrite
739 (Source : in out Unbounded_String;
740 Position : Positive;
741 New_Item : String)
742 is
743 NL : constant Natural := New_Item'Length;
744 begin
745 if Position <= Source.Last - NL + 1 then
746 Source.Reference (Position .. Position + NL - 1) := New_Item;
747 else
748 declare
749 Old : String_Access := Source.Reference;
750 begin
751 Source.Reference := new String'
752 (Fixed.Overwrite
753 (Source.Reference (1 .. Source.Last), Position, New_Item));
754 Source.Last := Source.Reference'Length;
755 Free (Old);
756 end;
757 end if;
758 end Overwrite;
759
760 -----------------------
761 -- Realloc_For_Chunk --
762 -----------------------
763
764 procedure Realloc_For_Chunk
765 (Source : in out Unbounded_String;
766 Chunk_Size : Natural)
767 is
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.
775
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.
781
782 S_Length : constant Natural := Source.Reference'Length;
783
784 begin
785 if Chunk_Size > S_Length - Source.Last then
786 declare
787 New_Size : constant Positive :=
788 S_Length + Chunk_Size + (S_Length / Growth_Factor);
789
790 New_Rounded_Up_Size : constant Positive :=
791 ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
792
793 Tmp : constant String_Access :=
794 new String (1 .. New_Rounded_Up_Size);
795
796 begin
797 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
798 Free (Source.Reference);
799 Source.Reference := Tmp;
800 end;
801 end if;
802 end Realloc_For_Chunk;
803
804 ---------------------
805 -- Replace_Element --
806 ---------------------
807
808 procedure Replace_Element
809 (Source : in out Unbounded_String;
810 Index : Positive;
811 By : Character)
812 is
813 begin
814 if Index <= Source.Last then
815 Source.Reference (Index) := By;
816 else
817 raise Strings.Index_Error;
818 end if;
819 end Replace_Element;
820
821 -------------------
822 -- Replace_Slice --
823 -------------------
824
825 function Replace_Slice
826 (Source : Unbounded_String;
827 Low : Positive;
828 High : Natural;
829 By : String) return Unbounded_String
830 is
831 begin
832 return To_Unbounded_String
833 (Fixed.Replace_Slice
834 (Source.Reference (1 .. Source.Last), Low, High, By));
835 end Replace_Slice;
836
837 procedure Replace_Slice
838 (Source : in out Unbounded_String;
839 Low : Positive;
840 High : Natural;
841 By : String)
842 is
843 Old : String_Access := Source.Reference;
844 begin
845 Source.Reference := new String'
846 (Fixed.Replace_Slice
847 (Source.Reference (1 .. Source.Last), Low, High, By));
848 Source.Last := Source.Reference'Length;
849 Free (Old);
850 end Replace_Slice;
851
852 --------------------------
853 -- Set_Unbounded_String --
854 --------------------------
855
856 procedure Set_Unbounded_String
857 (Target : out Unbounded_String;
858 Source : String)
859 is
860 Old : String_Access := Target.Reference;
861 begin
862 Target.Last := Source'Length;
863 Target.Reference := new String (1 .. Source'Length);
864 Target.Reference.all := Source;
865 Free (Old);
866 end Set_Unbounded_String;
867
868 -----------
869 -- Slice --
870 -----------
871
872 function Slice
873 (Source : Unbounded_String;
874 Low : Positive;
875 High : Natural) return String
876 is
877 begin
878 -- Note: test of High > Length is in accordance with AI95-00128
879
880 if Low > Source.Last + 1 or else High > Source.Last then
881 raise Index_Error;
882 else
883 return Source.Reference (Low .. High);
884 end if;
885 end Slice;
886
887 ----------
888 -- Tail --
889 ----------
890
891 function Tail
892 (Source : Unbounded_String;
893 Count : Natural;
894 Pad : Character := Space) return Unbounded_String is
895 begin
896 return To_Unbounded_String
897 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
898 end Tail;
899
900 procedure Tail
901 (Source : in out Unbounded_String;
902 Count : Natural;
903 Pad : Character := Space)
904 is
905 Old : String_Access := Source.Reference;
906 begin
907 Source.Reference := new String'
908 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
909 Source.Last := Source.Reference'Length;
910 Free (Old);
911 end Tail;
912
913 ---------------
914 -- To_String --
915 ---------------
916
917 function To_String (Source : Unbounded_String) return String is
918 begin
919 return Source.Reference (1 .. Source.Last);
920 end To_String;
921
922 -------------------------
923 -- To_Unbounded_String --
924 -------------------------
925
926 function To_Unbounded_String (Source : String) return Unbounded_String is
927 Result : Unbounded_String;
928 begin
929 -- Do not allocate an empty string: keep the default
930
931 if Source'Length > 0 then
932 Result.Last := Source'Length;
933 Result.Reference := new String (1 .. Source'Length);
934 Result.Reference.all := Source;
935 end if;
936
937 return Result;
938 end To_Unbounded_String;
939
940 function To_Unbounded_String
941 (Length : Natural) return Unbounded_String
942 is
943 Result : Unbounded_String;
944
945 begin
946 -- Do not allocate an empty string: keep the default
947
948 if Length > 0 then
949 Result.Last := Length;
950 Result.Reference := new String (1 .. Length);
951 end if;
952
953 return Result;
954 end To_Unbounded_String;
955
956 ---------------
957 -- Translate --
958 ---------------
959
960 function Translate
961 (Source : Unbounded_String;
962 Mapping : Maps.Character_Mapping) return Unbounded_String
963 is
964 begin
965 return To_Unbounded_String
966 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
967 end Translate;
968
969 procedure Translate
970 (Source : in out Unbounded_String;
971 Mapping : Maps.Character_Mapping)
972 is
973 begin
974 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
975 end Translate;
976
977 function Translate
978 (Source : Unbounded_String;
979 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
980 is
981 begin
982 return To_Unbounded_String
983 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
984 end Translate;
985
986 procedure Translate
987 (Source : in out Unbounded_String;
988 Mapping : Maps.Character_Mapping_Function)
989 is
990 begin
991 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
992 end Translate;
993
994 ----------
995 -- Trim --
996 ----------
997
998 function Trim
999 (Source : Unbounded_String;
1000 Side : Trim_End) return Unbounded_String
1001 is
1002 begin
1003 return To_Unbounded_String
1004 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1005 end Trim;
1006
1007 procedure Trim
1008 (Source : in out Unbounded_String;
1009 Side : Trim_End)
1010 is
1011 Old : String_Access := Source.Reference;
1012 begin
1013 Source.Reference := new String'
1014 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1015 Source.Last := Source.Reference'Length;
1016 Free (Old);
1017 end Trim;
1018
1019 function Trim
1020 (Source : Unbounded_String;
1021 Left : Maps.Character_Set;
1022 Right : Maps.Character_Set) return Unbounded_String
1023 is
1024 begin
1025 return To_Unbounded_String
1026 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1027 end Trim;
1028
1029 procedure Trim
1030 (Source : in out Unbounded_String;
1031 Left : Maps.Character_Set;
1032 Right : Maps.Character_Set)
1033 is
1034 Old : String_Access := Source.Reference;
1035 begin
1036 Source.Reference := new String'
1037 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
1038 Source.Last := Source.Reference'Length;
1039 Free (Old);
1040 end Trim;
1041
1042 ---------------------
1043 -- Unbounded_Slice --
1044 ---------------------
1045
1046 function Unbounded_Slice
1047 (Source : Unbounded_String;
1048 Low : Positive;
1049 High : Natural) return Unbounded_String
1050 is
1051 begin
1052 if Low > Source.Last + 1 or else High > Source.Last then
1053 raise Index_Error;
1054 else
1055 return To_Unbounded_String (Source.Reference.all (Low .. High));
1056 end if;
1057 end Unbounded_Slice;
1058
1059 procedure Unbounded_Slice
1060 (Source : Unbounded_String;
1061 Target : out Unbounded_String;
1062 Low : Positive;
1063 High : Natural)
1064 is
1065 begin
1066 if Low > Source.Last + 1 or else High > Source.Last then
1067 raise Index_Error;
1068 else
1069 Target := To_Unbounded_String (Source.Reference.all (Low .. High));
1070 end if;
1071 end Unbounded_Slice;
1072
1073 end Ada.Strings.Unbounded;