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-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
.Wide_Search
;
33 with Ada
.Unchecked_Deallocation
;
35 package body Ada
.Strings
.Wide_Unbounded
is
37 use Ada
.Strings
.Wide_Maps
;
39 Growth_Factor
: constant := 32;
40 -- The growth factor controls how much extra space is allocated when
41 -- we have to increase the size of an allocated unbounded string. By
42 -- allocating extra space, we avoid the need to reallocate on every
43 -- append, particularly important when a string is built up by repeated
44 -- append operations of small pieces. This is expressed as a factor so
45 -- 32 means add 1/32 of the length of the string as growth space.
47 Min_Mul_Alloc
: constant := Standard
'Maximum_Alignment;
48 -- Allocation will be done by a multiple of Min_Mul_Alloc. This causes
49 -- no memory loss as most (all?) malloc implementations are obliged to
50 -- align the returned memory on the maximum alignment as malloc does not
51 -- know the target alignment.
53 procedure Sync_Add_And_Fetch
54 (Ptr
: access Interfaces
.Unsigned_32
;
55 Value
: Interfaces
.Unsigned_32
);
56 pragma Import
(Intrinsic
, Sync_Add_And_Fetch
, "__sync_add_and_fetch_4");
58 function Sync_Sub_And_Fetch
59 (Ptr
: access Interfaces
.Unsigned_32
;
60 Value
: Interfaces
.Unsigned_32
) return Interfaces
.Unsigned_32
;
61 pragma Import
(Intrinsic
, Sync_Sub_And_Fetch
, "__sync_sub_and_fetch_4");
63 function Aligned_Max_Length
(Max_Length
: Natural) return Natural;
64 -- Returns recommended length of the shared string which is greater or
65 -- equal to specified length. Calculation take in sense alignment of
66 -- the allocated memory segments to use memory effectively by
67 -- Append/Insert/etc operations.
74 (Left
: Unbounded_Wide_String
;
75 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
77 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
78 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
79 DL
: constant Natural := LR
.Last
+ RR
.Last
;
80 DR
: Shared_Wide_String_Access
;
83 -- Result is an empty string, reuse shared empty string.
86 Reference
(Empty_Shared_Wide_String
'Access);
87 DR
:= Empty_Shared_Wide_String
'Access;
89 -- Left string is empty, return Rigth string.
91 elsif LR
.Last
= 0 then
95 -- Right string is empty, return Left string.
97 elsif RR
.Last
= 0 then
101 -- Overwise, allocate new shared string and fill data.
104 DR
:= Allocate
(LR
.Last
+ RR
.Last
);
105 DR
.Data
(1 .. LR
.Last
) := LR
.Data
(1 .. LR
.Last
);
106 DR
.Data
(LR
.Last
+ 1 .. DL
) := RR
.Data
(1 .. RR
.Last
);
110 return (AF
.Controlled
with Reference
=> DR
);
114 (Left
: Unbounded_Wide_String
;
115 Right
: Wide_String) return Unbounded_Wide_String
117 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
118 DL
: constant Natural := LR
.Last
+ Right
'Length;
119 DR
: Shared_Wide_String_Access
;
122 -- Result is an empty string, reuse shared empty string.
125 Reference
(Empty_Shared_Wide_String
'Access);
126 DR
:= Empty_Shared_Wide_String
'Access;
128 -- Right is an empty string, return Left string.
130 elsif Right
'Length = 0 then
134 -- Otherwise, allocate new shared string and fill it.
138 DR
.Data
(1 .. LR
.Last
) := LR
.Data
(1 .. LR
.Last
);
139 DR
.Data
(LR
.Last
+ 1 .. DL
) := Right
;
143 return (AF
.Controlled
with Reference
=> DR
);
148 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
150 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
151 DL
: constant Natural := Left
'Length + RR
.Last
;
152 DR
: Shared_Wide_String_Access
;
155 -- Result is an empty string, reuse shared one.
158 Reference
(Empty_Shared_Wide_String
'Access);
159 DR
:= Empty_Shared_Wide_String
'Access;
161 -- Left is empty string, return Right string.
163 elsif Left
'Length = 0 then
167 -- Otherwise, allocate new shared string and fill it.
171 DR
.Data
(1 .. Left
'Length) := Left
;
172 DR
.Data
(Left
'Length + 1 .. DL
) := RR
.Data
(1 .. RR
.Last
);
176 return (AF
.Controlled
with Reference
=> DR
);
180 (Left
: Unbounded_Wide_String
;
181 Right
: Wide_Character) return Unbounded_Wide_String
183 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
184 DL
: constant Natural := LR
.Last
+ 1;
185 DR
: Shared_Wide_String_Access
;
189 DR
.Data
(1 .. LR
.Last
) := LR
.Data
(1 .. LR
.Last
);
190 DR
.Data
(DL
) := Right
;
193 return (AF
.Controlled
with Reference
=> DR
);
197 (Left
: Wide_Character;
198 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
200 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
201 DL
: constant Natural := 1 + RR
.Last
;
202 DR
: Shared_Wide_String_Access
;
207 DR
.Data
(2 .. DL
) := RR
.Data
(1 .. RR
.Last
);
210 return (AF
.Controlled
with Reference
=> DR
);
219 Right
: Wide_Character) return Unbounded_Wide_String
221 DR
: Shared_Wide_String_Access
;
224 -- Result is an empty string, reuse shared empty string.
227 Reference
(Empty_Shared_Wide_String
'Access);
228 DR
:= Empty_Shared_Wide_String
'Access;
230 -- Otherwise, allocate new shared string and fill it.
233 DR
:= Allocate
(Left
);
235 for J
in 1 .. Left
loop
236 DR
.Data
(J
) := Right
;
242 return (AF
.Controlled
with Reference
=> DR
);
247 Right
: Wide_String) return Unbounded_Wide_String
249 DL
: constant Natural := Left
* Right
'Length;
250 DR
: Shared_Wide_String_Access
;
254 -- Result is an empty string, reuse shared empty string.
257 Reference
(Empty_Shared_Wide_String
'Access);
258 DR
:= Empty_Shared_Wide_String
'Access;
260 -- Otherwise, allocate new shared string and fill it.
266 for J
in 1 .. Left
loop
267 DR
.Data
(K
.. K
+ Right
'Length - 1) := Right
;
268 K
:= K
+ Right
'Length;
274 return (AF
.Controlled
with Reference
=> DR
);
279 Right
: Unbounded_Wide_String
) return Unbounded_Wide_String
281 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
282 DL
: constant Natural := Left
* RR
.Last
;
283 DR
: Shared_Wide_String_Access
;
287 -- Result is an empty string, reuse shared empty string.
290 Reference
(Empty_Shared_Wide_String
'Access);
291 DR
:= Empty_Shared_Wide_String
'Access;
293 -- Coefficient is one, just return string itself.
299 -- Otherwise, allocate new shared string and fill it.
305 for J
in 1 .. Left
loop
306 DR
.Data
(K
.. K
+ RR
.Last
- 1) := RR
.Data
(1 .. RR
.Last
);
313 return (AF
.Controlled
with Reference
=> DR
);
321 (Left
: Unbounded_Wide_String
;
322 Right
: Unbounded_Wide_String
) return Boolean
324 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
325 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
327 return LR
.Data
(1 .. LR
.Last
) < RR
.Data
(1 .. RR
.Last
);
331 (Left
: Unbounded_Wide_String
;
332 Right
: Wide_String) return Boolean
334 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
336 return LR
.Data
(1 .. LR
.Last
) < Right
;
341 Right
: Unbounded_Wide_String
) return Boolean
343 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
345 return Left
< RR
.Data
(1 .. RR
.Last
);
353 (Left
: Unbounded_Wide_String
;
354 Right
: Unbounded_Wide_String
) return Boolean
356 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
357 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
360 -- LR = RR means two strings shares shared string, thus they are equal
362 return LR
= RR
or else LR
.Data
(1 .. LR
.Last
) <= RR
.Data
(1 .. RR
.Last
);
366 (Left
: Unbounded_Wide_String
;
367 Right
: Wide_String) return Boolean
369 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
371 return LR
.Data
(1 .. LR
.Last
) <= Right
;
376 Right
: Unbounded_Wide_String
) return Boolean
378 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
380 return Left
<= RR
.Data
(1 .. RR
.Last
);
388 (Left
: Unbounded_Wide_String
;
389 Right
: Unbounded_Wide_String
) return Boolean
391 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
392 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
395 return LR
= RR
or else LR
.Data
(1 .. LR
.Last
) = RR
.Data
(1 .. RR
.Last
);
396 -- LR = RR means two strings shares shared string, thus they are equal.
400 (Left
: Unbounded_Wide_String
;
401 Right
: Wide_String) return Boolean
403 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
405 return LR
.Data
(1 .. LR
.Last
) = Right
;
410 Right
: Unbounded_Wide_String
) return Boolean
412 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
414 return Left
= RR
.Data
(1 .. RR
.Last
);
422 (Left
: Unbounded_Wide_String
;
423 Right
: Unbounded_Wide_String
) return Boolean
425 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
426 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
428 return LR
.Data
(1 .. LR
.Last
) > RR
.Data
(1 .. RR
.Last
);
432 (Left
: Unbounded_Wide_String
;
433 Right
: Wide_String) return Boolean
435 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
437 return LR
.Data
(1 .. LR
.Last
) > Right
;
442 Right
: Unbounded_Wide_String
) return Boolean
444 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
446 return Left
> RR
.Data
(1 .. RR
.Last
);
454 (Left
: Unbounded_Wide_String
;
455 Right
: Unbounded_Wide_String
) return Boolean
457 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
458 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
461 -- LR = RR means two strings shares shared string, thus they are equal
463 return LR
= RR
or else LR
.Data
(1 .. LR
.Last
) >= RR
.Data
(1 .. RR
.Last
);
467 (Left
: Unbounded_Wide_String
;
468 Right
: Wide_String) return Boolean
470 LR
: constant Shared_Wide_String_Access
:= Left
.Reference
;
472 return LR
.Data
(1 .. LR
.Last
) >= Right
;
477 Right
: Unbounded_Wide_String
) return Boolean
479 RR
: constant Shared_Wide_String_Access
:= Right
.Reference
;
481 return Left
>= RR
.Data
(1 .. RR
.Last
);
488 procedure Adjust
(Object
: in out Unbounded_Wide_String
) is
490 Reference
(Object
.Reference
);
493 ------------------------
494 -- Aligned_Max_Length --
495 ------------------------
497 function Aligned_Max_Length
(Max_Length
: Natural) return Natural is
498 Static_Size
: constant Natural :=
499 Empty_Shared_Wide_String
'Size / Standard
'Storage_Unit;
500 -- Total size of all static components
502 Element_Size
: constant Natural :=
503 Wide_Character'Size / Standard
'Storage_Unit;
507 (((Static_Size
+ Max_Length
* Element_Size
- 1) / Min_Mul_Alloc
+ 2)
508 * Min_Mul_Alloc
- Static_Size
) / Element_Size
;
509 end Aligned_Max_Length
;
515 function Allocate
(Max_Length
: Natural) return Shared_Wide_String_Access
is
517 -- Empty string requested, return shared empty string
519 if Max_Length
= 0 then
520 Reference
(Empty_Shared_Wide_String
'Access);
521 return Empty_Shared_Wide_String
'Access;
523 -- Otherwise, allocate requested space (and probably some more room)
526 return new Shared_Wide_String
(Aligned_Max_Length
(Max_Length
));
535 (Source
: in out Unbounded_Wide_String
;
536 New_Item
: Unbounded_Wide_String
)
538 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
539 NR
: constant Shared_Wide_String_Access
:= New_Item
.Reference
;
540 DL
: constant Natural := SR
.Last
+ NR
.Last
;
541 DR
: Shared_Wide_String_Access
;
544 -- Source is an empty string, reuse New_Item data
548 Source
.Reference
:= NR
;
551 -- New_Item is empty string, nothing to do
553 elsif NR
.Last
= 0 then
556 -- Try to reuse existent shared string
558 elsif Can_Be_Reused
(SR
, DL
) then
559 SR
.Data
(SR
.Last
+ 1 .. DL
) := NR
.Data
(1 .. NR
.Last
);
562 -- Otherwise, allocate new one and fill it
565 DR
:= Allocate
(DL
+ DL
/ Growth_Factor
);
566 DR
.Data
(1 .. SR
.Last
) := SR
.Data
(1 .. SR
.Last
);
567 DR
.Data
(SR
.Last
+ 1 .. DL
) := NR
.Data
(1 .. NR
.Last
);
569 Source
.Reference
:= DR
;
575 (Source
: in out Unbounded_Wide_String
;
576 New_Item
: Wide_String)
578 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
579 DL
: constant Natural := SR
.Last
+ New_Item
'Length;
580 DR
: Shared_Wide_String_Access
;
583 -- New_Item is an empty string, nothing to do
585 if New_Item
'Length = 0 then
588 -- Try to reuse existing shared string
590 elsif Can_Be_Reused
(SR
, DL
) then
591 SR
.Data
(SR
.Last
+ 1 .. DL
) := New_Item
;
594 -- Otherwise, allocate new one and fill it
597 DR
:= Allocate
(DL
+ DL
/ Growth_Factor
);
598 DR
.Data
(1 .. SR
.Last
) := SR
.Data
(1 .. SR
.Last
);
599 DR
.Data
(SR
.Last
+ 1 .. DL
) := New_Item
;
601 Source
.Reference
:= DR
;
607 (Source
: in out Unbounded_Wide_String
;
608 New_Item
: Wide_Character)
610 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
611 DL
: constant Natural := SR
.Last
+ 1;
612 DR
: Shared_Wide_String_Access
;
615 -- Try to reuse existing shared string
617 if Can_Be_Reused
(SR
, SR
.Last
+ 1) then
618 SR
.Data
(SR
.Last
+ 1) := New_Item
;
619 SR
.Last
:= SR
.Last
+ 1;
621 -- Otherwise, allocate new one and fill it
624 DR
:= Allocate
(DL
+ DL
/ Growth_Factor
);
625 DR
.Data
(1 .. SR
.Last
) := SR
.Data
(1 .. SR
.Last
);
626 DR
.Data
(DL
) := New_Item
;
628 Source
.Reference
:= DR
;
637 function Can_Be_Reused
638 (Item
: Shared_Wide_String_Access
;
639 Length
: Natural) return Boolean
645 and then Item
.Max_Length
>= Length
646 and then Item
.Max_Length
<=
647 Aligned_Max_Length
(Length
+ Length
/ Growth_Factor
);
655 (Source
: Unbounded_Wide_String
;
656 Pattern
: Wide_String;
657 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
660 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
662 return Wide_Search
.Count
(SR
.Data
(1 .. SR
.Last
), Pattern
, Mapping
);
666 (Source
: Unbounded_Wide_String
;
667 Pattern
: Wide_String;
668 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
670 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
672 return Wide_Search
.Count
(SR
.Data
(1 .. SR
.Last
), Pattern
, Mapping
);
676 (Source
: Unbounded_Wide_String
;
677 Set
: Wide_Maps
.Wide_Character_Set
) return Natural
679 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
681 return Wide_Search
.Count
(SR
.Data
(1 .. SR
.Last
), Set
);
689 (Source
: Unbounded_Wide_String
;
691 Through
: Natural) return Unbounded_Wide_String
693 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
695 DR
: Shared_Wide_String_Access
;
698 -- Empty slice is deleted, use the same shared string
700 if From
> Through
then
704 -- Index is out of range
706 elsif Through
> SR
.Last
then
709 -- Compute size of the result
712 DL
:= SR
.Last
- (Through
- From
+ 1);
714 -- Result is an empty string, reuse shared empty string
717 Reference
(Empty_Shared_Wide_String
'Access);
718 DR
:= Empty_Shared_Wide_String
'Access;
720 -- Otherwise, allocate new shared string and fill it
724 DR
.Data
(1 .. From
- 1) := SR
.Data
(1 .. From
- 1);
725 DR
.Data
(From
.. DL
) := SR
.Data
(Through
+ 1 .. SR
.Last
);
730 return (AF
.Controlled
with Reference
=> DR
);
734 (Source
: in out Unbounded_Wide_String
;
738 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
740 DR
: Shared_Wide_String_Access
;
743 -- Nothing changed, return
745 if From
> Through
then
748 -- Through is outside of the range
750 elsif Through
> SR
.Last
then
754 DL
:= SR
.Last
- (Through
- From
+ 1);
756 -- Result is empty, reuse shared empty string
759 Reference
(Empty_Shared_Wide_String
'Access);
760 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
763 -- Try to reuse existent shared string
765 elsif Can_Be_Reused
(SR
, DL
) then
766 SR
.Data
(From
.. DL
) := SR
.Data
(Through
+ 1 .. SR
.Last
);
769 -- Otherwise, allocate new shared string
773 DR
.Data
(1 .. From
- 1) := SR
.Data
(1 .. From
- 1);
774 DR
.Data
(From
.. DL
) := SR
.Data
(Through
+ 1 .. SR
.Last
);
776 Source
.Reference
:= DR
;
787 (Source
: Unbounded_Wide_String
;
788 Index
: Positive) return Wide_Character
790 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
792 if Index
<= SR
.Last
then
793 return SR
.Data
(Index
);
803 procedure Finalize
(Object
: in out Unbounded_Wide_String
) is
804 SR
: constant Shared_Wide_String_Access
:= Object
.Reference
;
809 -- The same controlled object can be finalized several times for
810 -- some reason. As per 7.6.1(24) this should have no ill effect,
811 -- so we need to add a guard for the case of finalizing the same
814 Object
.Reference
:= null;
824 (Source
: Unbounded_Wide_String
;
825 Set
: Wide_Maps
.Wide_Character_Set
;
826 Test
: Strings
.Membership
;
827 First
: out Positive;
830 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
832 Wide_Search
.Find_Token
(SR
.Data
(1 .. SR
.Last
), Set
, Test
, First
, Last
);
839 procedure Free
(X
: in out Wide_String_Access
) is
840 procedure Deallocate
is
841 new Ada
.Unchecked_Deallocation
(Wide_String, Wide_String_Access
);
851 (Source
: Unbounded_Wide_String
;
853 Pad
: Wide_Character := Wide_Space
) return Unbounded_Wide_String
855 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
856 DR
: Shared_Wide_String_Access
;
859 -- Result is empty, reuse shared empty string
862 Reference
(Empty_Shared_Wide_String
'Access);
863 DR
:= Empty_Shared_Wide_String
'Access;
865 -- Length of the string is the same as requested, reuse source shared
868 elsif Count
= SR
.Last
then
872 -- Otherwise, allocate new shared string and fill it
875 DR
:= Allocate
(Count
);
877 -- Length of the source string is more than requested, copy
878 -- corresponding slice.
880 if Count
< SR
.Last
then
881 DR
.Data
(1 .. Count
) := SR
.Data
(1 .. Count
);
883 -- Length of the source string is less then requested, copy all
884 -- contents and fill others by Pad character.
887 DR
.Data
(1 .. SR
.Last
) := SR
.Data
(1 .. SR
.Last
);
889 for J
in SR
.Last
+ 1 .. Count
loop
897 return (AF
.Controlled
with Reference
=> DR
);
901 (Source
: in out Unbounded_Wide_String
;
903 Pad
: Wide_Character := Wide_Space
)
905 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
906 DR
: Shared_Wide_String_Access
;
909 -- Result is empty, reuse empty shared string
912 Reference
(Empty_Shared_Wide_String
'Access);
913 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
916 -- Result is same with source string, reuse source shared string
918 elsif Count
= SR
.Last
then
921 -- Try to reuse existent shared string
923 elsif Can_Be_Reused
(SR
, Count
) then
924 if Count
> SR
.Last
then
925 for J
in SR
.Last
+ 1 .. Count
loop
932 -- Otherwise, allocate new shared string and fill it
935 DR
:= Allocate
(Count
);
937 -- Length of the source string is greater then requested, copy
938 -- corresponding slice.
940 if Count
< SR
.Last
then
941 DR
.Data
(1 .. Count
) := SR
.Data
(1 .. Count
);
943 -- Length of the source string is less the requested, copy all
944 -- exists data and fill others by Pad character.
947 DR
.Data
(1 .. SR
.Last
) := SR
.Data
(1 .. SR
.Last
);
949 for J
in SR
.Last
+ 1 .. Count
loop
955 Source
.Reference
:= DR
;
965 (Source
: Unbounded_Wide_String
;
966 Pattern
: Wide_String;
967 Going
: Strings
.Direction
:= Strings
.Forward
;
968 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
971 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
973 return Wide_Search
.Index
974 (SR
.Data
(1 .. SR
.Last
), Pattern
, Going
, Mapping
);
978 (Source
: Unbounded_Wide_String
;
979 Pattern
: Wide_String;
980 Going
: Direction
:= Forward
;
981 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
983 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
985 return Wide_Search
.Index
986 (SR
.Data
(1 .. SR
.Last
), Pattern
, Going
, Mapping
);
990 (Source
: Unbounded_Wide_String
;
991 Set
: Wide_Maps
.Wide_Character_Set
;
992 Test
: Strings
.Membership
:= Strings
.Inside
;
993 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
995 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
997 return Wide_Search
.Index
(SR
.Data
(1 .. SR
.Last
), Set
, Test
, Going
);
1001 (Source
: Unbounded_Wide_String
;
1002 Pattern
: Wide_String;
1004 Going
: Direction
:= Forward
;
1005 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
1008 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1010 return Wide_Search
.Index
1011 (SR
.Data
(1 .. SR
.Last
), Pattern
, From
, Going
, Mapping
);
1015 (Source
: Unbounded_Wide_String
;
1016 Pattern
: Wide_String;
1018 Going
: Direction
:= Forward
;
1019 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
1021 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1023 return Wide_Search
.Index
1024 (SR
.Data
(1 .. SR
.Last
), Pattern
, From
, Going
, Mapping
);
1028 (Source
: Unbounded_Wide_String
;
1029 Set
: Wide_Maps
.Wide_Character_Set
;
1031 Test
: Membership
:= Inside
;
1032 Going
: Direction
:= Forward
) return Natural
1034 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1036 return Wide_Search
.Index
1037 (SR
.Data
(1 .. SR
.Last
), Set
, From
, Test
, Going
);
1040 ---------------------
1041 -- Index_Non_Blank --
1042 ---------------------
1044 function Index_Non_Blank
1045 (Source
: Unbounded_Wide_String
;
1046 Going
: Strings
.Direction
:= Strings
.Forward
) return Natural
1048 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1050 return Wide_Search
.Index_Non_Blank
(SR
.Data
(1 .. SR
.Last
), Going
);
1051 end Index_Non_Blank
;
1053 function Index_Non_Blank
1054 (Source
: Unbounded_Wide_String
;
1056 Going
: Direction
:= Forward
) return Natural
1058 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1060 return Wide_Search
.Index_Non_Blank
1061 (SR
.Data
(1 .. SR
.Last
), From
, Going
);
1062 end Index_Non_Blank
;
1068 procedure Initialize
(Object
: in out Unbounded_Wide_String
) is
1070 Reference
(Object
.Reference
);
1078 (Source
: Unbounded_Wide_String
;
1080 New_Item
: Wide_String) return Unbounded_Wide_String
1082 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1083 DL
: constant Natural := SR
.Last
+ New_Item
'Length;
1084 DR
: Shared_Wide_String_Access
;
1087 -- Check index first
1089 if Before
> SR
.Last
+ 1 then
1093 -- Result is empty, reuse empty shared string
1096 Reference
(Empty_Shared_Wide_String
'Access);
1097 DR
:= Empty_Shared_Wide_String
'Access;
1099 -- Inserted string is empty, reuse source shared string
1101 elsif New_Item
'Length = 0 then
1105 -- Otherwise, allocate new shared string and fill it
1108 DR
:= Allocate
(DL
+ DL
/ Growth_Factor
);
1109 DR
.Data
(1 .. Before
- 1) := SR
.Data
(1 .. Before
- 1);
1110 DR
.Data
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
1111 DR
.Data
(Before
+ New_Item
'Length .. DL
) :=
1112 SR
.Data
(Before
.. SR
.Last
);
1116 return (AF
.Controlled
with Reference
=> DR
);
1120 (Source
: in out Unbounded_Wide_String
;
1122 New_Item
: Wide_String)
1124 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1125 DL
: constant Natural := SR
.Last
+ New_Item
'Length;
1126 DR
: Shared_Wide_String_Access
;
1131 if Before
> SR
.Last
+ 1 then
1135 -- Result is empty string, reuse empty shared string
1138 Reference
(Empty_Shared_Wide_String
'Access);
1139 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1142 -- Inserted string is empty, nothing to do
1144 elsif New_Item
'Length = 0 then
1147 -- Try to reuse existent shared string first
1149 elsif Can_Be_Reused
(SR
, DL
) then
1150 SR
.Data
(Before
+ New_Item
'Length .. DL
) :=
1151 SR
.Data
(Before
.. SR
.Last
);
1152 SR
.Data
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
1155 -- Otherwise, allocate new shared string and fill it
1158 DR
:= Allocate
(DL
+ DL
/ Growth_Factor
);
1159 DR
.Data
(1 .. Before
- 1) := SR
.Data
(1 .. Before
- 1);
1160 DR
.Data
(Before
.. Before
+ New_Item
'Length - 1) := New_Item
;
1161 DR
.Data
(Before
+ New_Item
'Length .. DL
) :=
1162 SR
.Data
(Before
.. SR
.Last
);
1164 Source
.Reference
:= DR
;
1173 function Length
(Source
: Unbounded_Wide_String
) return Natural is
1175 return Source
.Reference
.Last
;
1183 (Source
: Unbounded_Wide_String
;
1184 Position
: Positive;
1185 New_Item
: Wide_String) return Unbounded_Wide_String
1187 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1189 DR
: Shared_Wide_String_Access
;
1194 if Position
> SR
.Last
+ 1 then
1198 DL
:= Integer'Max (SR
.Last
, Position
+ New_Item
'Length - 1);
1200 -- Result is empty string, reuse empty shared string
1203 Reference
(Empty_Shared_Wide_String
'Access);
1204 DR
:= Empty_Shared_Wide_String
'Access;
1206 -- Result is same with source string, reuse source shared string
1208 elsif New_Item
'Length = 0 then
1212 -- Otherwise, allocate new shared string and fill it
1215 DR
:= Allocate
(DL
);
1216 DR
.Data
(1 .. Position
- 1) := SR
.Data
(1 .. Position
- 1);
1217 DR
.Data
(Position
.. Position
+ New_Item
'Length - 1) := New_Item
;
1218 DR
.Data
(Position
+ New_Item
'Length .. DL
) :=
1219 SR
.Data
(Position
+ New_Item
'Length .. SR
.Last
);
1223 return (AF
.Controlled
with Reference
=> DR
);
1227 (Source
: in out Unbounded_Wide_String
;
1228 Position
: Positive;
1229 New_Item
: Wide_String)
1231 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1233 DR
: Shared_Wide_String_Access
;
1238 if Position
> SR
.Last
+ 1 then
1242 DL
:= Integer'Max (SR
.Last
, Position
+ New_Item
'Length - 1);
1244 -- Result is empty string, reuse empty shared string
1247 Reference
(Empty_Shared_Wide_String
'Access);
1248 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1251 -- String unchanged, nothing to do
1253 elsif New_Item
'Length = 0 then
1256 -- Try to reuse existent shared string
1258 elsif Can_Be_Reused
(SR
, DL
) then
1259 SR
.Data
(Position
.. Position
+ New_Item
'Length - 1) := New_Item
;
1262 -- Otherwise allocate new shared string and fill it
1265 DR
:= Allocate
(DL
);
1266 DR
.Data
(1 .. Position
- 1) := SR
.Data
(1 .. Position
- 1);
1267 DR
.Data
(Position
.. Position
+ New_Item
'Length - 1) := New_Item
;
1268 DR
.Data
(Position
+ New_Item
'Length .. DL
) :=
1269 SR
.Data
(Position
+ New_Item
'Length .. SR
.Last
);
1271 Source
.Reference
:= DR
;
1280 procedure Reference
(Item
: not null Shared_Wide_String_Access
) is
1282 Sync_Add_And_Fetch
(Item
.Counter
'Access, 1);
1285 ---------------------
1286 -- Replace_Element --
1287 ---------------------
1289 procedure Replace_Element
1290 (Source
: in out Unbounded_Wide_String
;
1292 By
: Wide_Character)
1294 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1295 DR
: Shared_Wide_String_Access
;
1300 if Index
<= SR
.Last
then
1302 -- Try to reuse existent shared string
1304 if Can_Be_Reused
(SR
, SR
.Last
) then
1305 SR
.Data
(Index
) := By
;
1307 -- Otherwise allocate new shared string and fill it
1310 DR
:= Allocate
(SR
.Last
);
1311 DR
.Data
(1 .. SR
.Last
) := SR
.Data
(1 .. SR
.Last
);
1312 DR
.Data
(Index
) := By
;
1314 Source
.Reference
:= DR
;
1321 end Replace_Element
;
1327 function Replace_Slice
1328 (Source
: Unbounded_Wide_String
;
1331 By
: Wide_String) return Unbounded_Wide_String
1333 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1335 DR
: Shared_Wide_String_Access
;
1340 if Low
> SR
.Last
+ 1 then
1344 -- Do replace operation when removed slice is not empty
1347 DL
:= By
'Length + SR
.Last
+ Low
- High
- 1;
1349 -- Result is empty string, reuse empty shared string
1352 Reference
(Empty_Shared_Wide_String
'Access);
1353 DR
:= Empty_Shared_Wide_String
'Access;
1355 -- Otherwise allocate new shared string and fill it
1358 DR
:= Allocate
(DL
);
1359 DR
.Data
(1 .. Low
- 1) := SR
.Data
(1 .. Low
- 1);
1360 DR
.Data
(Low
.. Low
+ By
'Length - 1) := By
;
1361 DR
.Data
(Low
+ By
'Length .. DL
) := SR
.Data
(High
+ 1 .. SR
.Last
);
1365 return (AF
.Controlled
with Reference
=> DR
);
1367 -- Otherwise just insert string
1370 return Insert
(Source
, Low
, By
);
1374 procedure Replace_Slice
1375 (Source
: in out Unbounded_Wide_String
;
1380 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1382 DR
: Shared_Wide_String_Access
;
1387 if Low
> SR
.Last
+ 1 then
1391 -- Do replace operation only when replaced slice is not empty
1394 DL
:= By
'Length + SR
.Last
+ Low
- High
- 1;
1396 -- Result is empty string, reuse empty shared string
1399 Reference
(Empty_Shared_Wide_String
'Access);
1400 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1403 -- Try to reuse existent shared string
1405 elsif Can_Be_Reused
(SR
, DL
) then
1406 SR
.Data
(Low
+ By
'Length .. DL
) := SR
.Data
(High
+ 1 .. SR
.Last
);
1407 SR
.Data
(Low
.. Low
+ By
'Length - 1) := By
;
1410 -- Otherwise allocate new shared string and fill it
1413 DR
:= Allocate
(DL
);
1414 DR
.Data
(1 .. Low
- 1) := SR
.Data
(1 .. Low
- 1);
1415 DR
.Data
(Low
.. Low
+ By
'Length - 1) := By
;
1416 DR
.Data
(Low
+ By
'Length .. DL
) := SR
.Data
(High
+ 1 .. SR
.Last
);
1418 Source
.Reference
:= DR
;
1422 -- Otherwise just insert item
1425 Insert
(Source
, Low
, By
);
1429 -------------------------------
1430 -- Set_Unbounded_Wide_String --
1431 -------------------------------
1433 procedure Set_Unbounded_Wide_String
1434 (Target
: out Unbounded_Wide_String
;
1435 Source
: Wide_String)
1437 TR
: constant Shared_Wide_String_Access
:= Target
.Reference
;
1438 DR
: Shared_Wide_String_Access
;
1441 -- In case of empty string, reuse empty shared string
1443 if Source
'Length = 0 then
1444 Reference
(Empty_Shared_Wide_String
'Access);
1445 Target
.Reference
:= Empty_Shared_Wide_String
'Access;
1448 -- Try to reuse existent shared string
1450 if Can_Be_Reused
(TR
, Source
'Length) then
1454 -- Otherwise allocate new shared string
1457 DR
:= Allocate
(Source
'Length);
1458 Target
.Reference
:= DR
;
1461 DR
.Data
(1 .. Source
'Length) := Source
;
1462 DR
.Last
:= Source
'Length;
1466 end Set_Unbounded_Wide_String
;
1473 (Source
: Unbounded_Wide_String
;
1475 High
: Natural) return Wide_String
1477 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1480 -- Note: test of High > Length is in accordance with AI95-00128
1482 if Low
> SR
.Last
+ 1 or else High
> SR
.Last
then
1486 return SR
.Data
(Low
.. High
);
1495 (Source
: Unbounded_Wide_String
;
1497 Pad
: Wide_Character := Wide_Space
) return Unbounded_Wide_String
1499 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1500 DR
: Shared_Wide_String_Access
;
1503 -- For empty result reuse empty shared string
1506 Reference
(Empty_Shared_Wide_String
'Access);
1507 DR
:= Empty_Shared_Wide_String
'Access;
1509 -- Result is hole source string, reuse source shared string
1511 elsif Count
= SR
.Last
then
1515 -- Otherwise allocate new shared string and fill it
1518 DR
:= Allocate
(Count
);
1520 if Count
< SR
.Last
then
1521 DR
.Data
(1 .. Count
) := SR
.Data
(SR
.Last
- Count
+ 1 .. SR
.Last
);
1524 for J
in 1 .. Count
- SR
.Last
loop
1528 DR
.Data
(Count
- SR
.Last
+ 1 .. Count
) := SR
.Data
(1 .. SR
.Last
);
1534 return (AF
.Controlled
with Reference
=> DR
);
1538 (Source
: in out Unbounded_Wide_String
;
1540 Pad
: Wide_Character := Wide_Space
)
1542 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1543 DR
: Shared_Wide_String_Access
;
1546 (SR
: Shared_Wide_String_Access
;
1547 DR
: Shared_Wide_String_Access
;
1549 -- Common code of tail computation. SR/DR can point to the same object
1556 (SR
: Shared_Wide_String_Access
;
1557 DR
: Shared_Wide_String_Access
;
1560 if Count
< SR
.Last
then
1561 DR
.Data
(1 .. Count
) := SR
.Data
(SR
.Last
- Count
+ 1 .. SR
.Last
);
1564 DR
.Data
(Count
- SR
.Last
+ 1 .. Count
) := SR
.Data
(1 .. SR
.Last
);
1566 for J
in 1 .. Count
- SR
.Last
loop
1575 -- Result is empty string, reuse empty shared string
1578 Reference
(Empty_Shared_Wide_String
'Access);
1579 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1582 -- Length of the result is the same with length of the source string,
1583 -- reuse source shared string.
1585 elsif Count
= SR
.Last
then
1588 -- Try to reuse existent shared string
1590 elsif Can_Be_Reused
(SR
, Count
) then
1591 Common
(SR
, SR
, Count
);
1593 -- Otherwise allocate new shared string and fill it
1596 DR
:= Allocate
(Count
);
1597 Common
(SR
, DR
, Count
);
1598 Source
.Reference
:= DR
;
1603 --------------------
1604 -- To_Wide_String --
1605 --------------------
1607 function To_Wide_String
1608 (Source
: Unbounded_Wide_String
) return Wide_String is
1610 return Source
.Reference
.Data
(1 .. Source
.Reference
.Last
);
1613 ------------------------------
1614 -- To_Unbounded_Wide_String --
1615 ------------------------------
1617 function To_Unbounded_Wide_String
1618 (Source
: Wide_String) return Unbounded_Wide_String
1620 DR
: constant Shared_Wide_String_Access
:= Allocate
(Source
'Length);
1622 DR
.Data
(1 .. Source
'Length) := Source
;
1623 DR
.Last
:= Source
'Length;
1624 return (AF
.Controlled
with Reference
=> DR
);
1625 end To_Unbounded_Wide_String
;
1627 function To_Unbounded_Wide_String
1628 (Length
: Natural) return Unbounded_Wide_String
1630 DR
: constant Shared_Wide_String_Access
:= Allocate
(Length
);
1633 return (AF
.Controlled
with Reference
=> DR
);
1634 end To_Unbounded_Wide_String
;
1641 (Source
: Unbounded_Wide_String
;
1642 Mapping
: Wide_Maps
.Wide_Character_Mapping
) return Unbounded_Wide_String
1644 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1645 DR
: Shared_Wide_String_Access
;
1648 -- Nothing to translate, reuse empty shared string
1651 Reference
(Empty_Shared_Wide_String
'Access);
1652 DR
:= Empty_Shared_Wide_String
'Access;
1654 -- Otherwise, allocate new shared string and fill it
1657 DR
:= Allocate
(SR
.Last
);
1659 for J
in 1 .. SR
.Last
loop
1660 DR
.Data
(J
) := Value
(Mapping
, SR
.Data
(J
));
1666 return (AF
.Controlled
with Reference
=> DR
);
1670 (Source
: in out Unbounded_Wide_String
;
1671 Mapping
: Wide_Maps
.Wide_Character_Mapping
)
1673 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1674 DR
: Shared_Wide_String_Access
;
1677 -- Nothing to translate
1682 -- Try to reuse shared string
1684 elsif Can_Be_Reused
(SR
, SR
.Last
) then
1685 for J
in 1 .. SR
.Last
loop
1686 SR
.Data
(J
) := Value
(Mapping
, SR
.Data
(J
));
1689 -- Otherwise, allocate new shared string
1692 DR
:= Allocate
(SR
.Last
);
1694 for J
in 1 .. SR
.Last
loop
1695 DR
.Data
(J
) := Value
(Mapping
, SR
.Data
(J
));
1699 Source
.Reference
:= DR
;
1705 (Source
: Unbounded_Wide_String
;
1706 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
)
1707 return Unbounded_Wide_String
1709 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1710 DR
: Shared_Wide_String_Access
;
1713 -- Nothing to translate, reuse empty shared string
1716 Reference
(Empty_Shared_Wide_String
'Access);
1717 DR
:= Empty_Shared_Wide_String
'Access;
1719 -- Otherwise, allocate new shared string and fill it
1722 DR
:= Allocate
(SR
.Last
);
1724 for J
in 1 .. SR
.Last
loop
1725 DR
.Data
(J
) := Mapping
.all (SR
.Data
(J
));
1731 return (AF
.Controlled
with Reference
=> DR
);
1741 (Source
: in out Unbounded_Wide_String
;
1742 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
)
1744 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1745 DR
: Shared_Wide_String_Access
;
1748 -- Nothing to translate
1753 -- Try to reuse shared string
1755 elsif Can_Be_Reused
(SR
, SR
.Last
) then
1756 for J
in 1 .. SR
.Last
loop
1757 SR
.Data
(J
) := Mapping
.all (SR
.Data
(J
));
1760 -- Otherwise allocate new shared string and fill it
1763 DR
:= Allocate
(SR
.Last
);
1765 for J
in 1 .. SR
.Last
loop
1766 DR
.Data
(J
) := Mapping
.all (SR
.Data
(J
));
1770 Source
.Reference
:= DR
;
1788 (Source
: Unbounded_Wide_String
;
1789 Side
: Trim_End
) return Unbounded_Wide_String
1791 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1793 DR
: Shared_Wide_String_Access
;
1798 Low
:= Index_Non_Blank
(Source
, Forward
);
1800 -- All blanks, reuse empty shared string
1803 Reference
(Empty_Shared_Wide_String
'Access);
1804 DR
:= Empty_Shared_Wide_String
'Access;
1810 DL
:= SR
.Last
- Low
+ 1;
1814 High
:= Index_Non_Blank
(Source
, Backward
);
1818 High
:= Index_Non_Blank
(Source
, Backward
);
1819 DL
:= High
- Low
+ 1;
1822 -- Length of the result is the same as length of the source string,
1823 -- reuse source shared string.
1825 if DL
= SR
.Last
then
1829 -- Otherwise, allocate new shared string
1832 DR
:= Allocate
(DL
);
1833 DR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
1838 return (AF
.Controlled
with Reference
=> DR
);
1842 (Source
: in out Unbounded_Wide_String
;
1845 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1847 DR
: Shared_Wide_String_Access
;
1852 Low
:= Index_Non_Blank
(Source
, Forward
);
1854 -- All blanks, reuse empty shared string
1857 Reference
(Empty_Shared_Wide_String
'Access);
1858 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1865 DL
:= SR
.Last
- Low
+ 1;
1869 High
:= Index_Non_Blank
(Source
, Backward
);
1873 High
:= Index_Non_Blank
(Source
, Backward
);
1874 DL
:= High
- Low
+ 1;
1877 -- Length of the result is the same as length of the source string,
1880 if DL
= SR
.Last
then
1883 -- Try to reuse existent shared string
1885 elsif Can_Be_Reused
(SR
, DL
) then
1886 SR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
1889 -- Otherwise, allocate new shared string
1892 DR
:= Allocate
(DL
);
1893 DR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
1895 Source
.Reference
:= DR
;
1902 (Source
: Unbounded_Wide_String
;
1903 Left
: Wide_Maps
.Wide_Character_Set
;
1904 Right
: Wide_Maps
.Wide_Character_Set
) return Unbounded_Wide_String
1906 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1908 DR
: Shared_Wide_String_Access
;
1913 Low
:= Index
(Source
, Left
, Outside
, Forward
);
1915 -- Source includes only characters from Left set, reuse empty shared
1919 Reference
(Empty_Shared_Wide_String
'Access);
1920 DR
:= Empty_Shared_Wide_String
'Access;
1923 High
:= Index
(Source
, Right
, Outside
, Backward
);
1924 DL
:= Integer'Max (0, High
- Low
+ 1);
1926 -- Source includes only characters from Right set or result string
1927 -- is empty, reuse empty shared string.
1929 if High
= 0 or else DL
= 0 then
1930 Reference
(Empty_Shared_Wide_String
'Access);
1931 DR
:= Empty_Shared_Wide_String
'Access;
1933 -- Otherwise, allocate new shared string and fill it
1936 DR
:= Allocate
(DL
);
1937 DR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
1942 return (AF
.Controlled
with Reference
=> DR
);
1946 (Source
: in out Unbounded_Wide_String
;
1947 Left
: Wide_Maps
.Wide_Character_Set
;
1948 Right
: Wide_Maps
.Wide_Character_Set
)
1950 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
1952 DR
: Shared_Wide_String_Access
;
1957 Low
:= Index
(Source
, Left
, Outside
, Forward
);
1959 -- Source includes only characters from Left set, reuse empty shared
1963 Reference
(Empty_Shared_Wide_String
'Access);
1964 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1968 High
:= Index
(Source
, Right
, Outside
, Backward
);
1969 DL
:= Integer'Max (0, High
- Low
+ 1);
1971 -- Source includes only characters from Right set or result string
1972 -- is empty, reuse empty shared string.
1974 if High
= 0 or else DL
= 0 then
1975 Reference
(Empty_Shared_Wide_String
'Access);
1976 Source
.Reference
:= Empty_Shared_Wide_String
'Access;
1979 -- Try to reuse existent shared string
1981 elsif Can_Be_Reused
(SR
, DL
) then
1982 SR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
1985 -- Otherwise, allocate new shared string and fill it
1988 DR
:= Allocate
(DL
);
1989 DR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
1991 Source
.Reference
:= DR
;
1997 ---------------------
1998 -- Unbounded_Slice --
1999 ---------------------
2001 function Unbounded_Slice
2002 (Source
: Unbounded_Wide_String
;
2004 High
: Natural) return Unbounded_Wide_String
2006 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
2008 DR
: Shared_Wide_String_Access
;
2013 if Low
> SR
.Last
+ 1 or else High
> SR
.Last
then
2016 -- Result is empty slice, reuse empty shared string
2018 elsif Low
> High
then
2019 Reference
(Empty_Shared_Wide_String
'Access);
2020 DR
:= Empty_Shared_Wide_String
'Access;
2022 -- Otherwise, allocate new shared string and fill it
2025 DL
:= High
- Low
+ 1;
2026 DR
:= Allocate
(DL
);
2027 DR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
2031 return (AF
.Controlled
with Reference
=> DR
);
2032 end Unbounded_Slice
;
2034 procedure Unbounded_Slice
2035 (Source
: Unbounded_Wide_String
;
2036 Target
: out Unbounded_Wide_String
;
2040 SR
: constant Shared_Wide_String_Access
:= Source
.Reference
;
2041 TR
: constant Shared_Wide_String_Access
:= Target
.Reference
;
2043 DR
: Shared_Wide_String_Access
;
2048 if Low
> SR
.Last
+ 1 or else High
> SR
.Last
then
2051 -- Result is empty slice, reuse empty shared string
2053 elsif Low
> High
then
2054 Reference
(Empty_Shared_Wide_String
'Access);
2055 Target
.Reference
:= Empty_Shared_Wide_String
'Access;
2059 DL
:= High
- Low
+ 1;
2061 -- Try to reuse existent shared string
2063 if Can_Be_Reused
(TR
, DL
) then
2064 TR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
2067 -- Otherwise, allocate new shared string and fill it
2070 DR
:= Allocate
(DL
);
2071 DR
.Data
(1 .. DL
) := SR
.Data
(Low
.. High
);
2073 Target
.Reference
:= DR
;
2077 end Unbounded_Slice
;
2083 procedure Unreference
(Item
: not null Shared_Wide_String_Access
) is
2087 new Ada
.Unchecked_Deallocation
2088 (Shared_Wide_String
, Shared_Wide_String_Access
);
2090 Aux
: Shared_Wide_String_Access
:= Item
;
2093 if Sync_Sub_And_Fetch
(Aux
.Counter
'Access, 1) = 0 then
2095 -- Reference counter of Empty_Shared_Wide_String must never reach
2098 pragma Assert
(Aux
/= Empty_Shared_Wide_String
'Access);
2104 end Ada
.Strings
.Wide_Unbounded
;