111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
4 -- --
|
|
5 -- A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D --
|
|
6 -- --
|
|
7 -- B o d y --
|
|
8 -- --
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
111
|
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 -- 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. --
|
|
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.Wide_Wide_Search;
|
|
33 with Ada.Unchecked_Deallocation;
|
|
34
|
|
35 package body Ada.Strings.Wide_Wide_Unbounded is
|
|
36
|
|
37 use Ada.Strings.Wide_Wide_Maps;
|
|
38
|
|
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.
|
|
46
|
|
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.
|
|
52
|
|
53 function Aligned_Max_Length (Max_Length : Natural) return Natural;
|
|
54 -- Returns recommended length of the shared string which is greater or
|
|
55 -- equal to specified length. Calculation take in sense alignment of
|
|
56 -- the allocated memory segments to use memory effectively by
|
|
57 -- Append/Insert/etc operations.
|
|
58
|
|
59 ---------
|
|
60 -- "&" --
|
|
61 ---------
|
|
62
|
|
63 function "&"
|
|
64 (Left : Unbounded_Wide_Wide_String;
|
|
65 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
66 is
|
|
67 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
68 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
69 DL : constant Natural := LR.Last + RR.Last;
|
|
70 DR : Shared_Wide_Wide_String_Access;
|
|
71
|
|
72 begin
|
|
73 -- Result is an empty string, reuse shared empty string
|
|
74
|
|
75 if DL = 0 then
|
|
76 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
77 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
78
|
|
79 -- Left string is empty, return Rigth string
|
|
80
|
|
81 elsif LR.Last = 0 then
|
|
82 Reference (RR);
|
|
83 DR := RR;
|
|
84
|
|
85 -- Right string is empty, return Left string
|
|
86
|
|
87 elsif RR.Last = 0 then
|
|
88 Reference (LR);
|
|
89 DR := LR;
|
|
90
|
|
91 -- Overwise, allocate new shared string and fill data
|
|
92
|
|
93 else
|
|
94 DR := Allocate (DL);
|
|
95 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
|
|
96 DR.Data (LR.Last + 1 .. DL) := RR.Data (1 .. RR.Last);
|
|
97 DR.Last := DL;
|
|
98 end if;
|
|
99
|
|
100 return (AF.Controlled with Reference => DR);
|
|
101 end "&";
|
|
102
|
|
103 function "&"
|
|
104 (Left : Unbounded_Wide_Wide_String;
|
|
105 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
106 is
|
|
107 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
108 DL : constant Natural := LR.Last + Right'Length;
|
|
109 DR : Shared_Wide_Wide_String_Access;
|
|
110
|
|
111 begin
|
|
112 -- Result is an empty string, reuse shared empty string
|
|
113
|
|
114 if DL = 0 then
|
|
115 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
116 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
117
|
|
118 -- Right is an empty string, return Left string
|
|
119
|
|
120 elsif Right'Length = 0 then
|
|
121 Reference (LR);
|
|
122 DR := LR;
|
|
123
|
|
124 -- Otherwise, allocate new shared string and fill it
|
|
125
|
|
126 else
|
|
127 DR := Allocate (DL);
|
|
128 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
|
|
129 DR.Data (LR.Last + 1 .. DL) := Right;
|
|
130 DR.Last := DL;
|
|
131 end if;
|
|
132
|
|
133 return (AF.Controlled with Reference => DR);
|
|
134 end "&";
|
|
135
|
|
136 function "&"
|
|
137 (Left : Wide_Wide_String;
|
|
138 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
139 is
|
|
140 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
141 DL : constant Natural := Left'Length + RR.Last;
|
|
142 DR : Shared_Wide_Wide_String_Access;
|
|
143
|
|
144 begin
|
|
145 -- Result is an empty string, reuse shared one
|
|
146
|
|
147 if DL = 0 then
|
|
148 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
149 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
150
|
|
151 -- Left is empty string, return Right string
|
|
152
|
|
153 elsif Left'Length = 0 then
|
|
154 Reference (RR);
|
|
155 DR := RR;
|
|
156
|
|
157 -- Otherwise, allocate new shared string and fill it
|
|
158
|
|
159 else
|
|
160 DR := Allocate (DL);
|
|
161 DR.Data (1 .. Left'Length) := Left;
|
|
162 DR.Data (Left'Length + 1 .. DL) := RR.Data (1 .. RR.Last);
|
|
163 DR.Last := DL;
|
|
164 end if;
|
|
165
|
|
166 return (AF.Controlled with Reference => DR);
|
|
167 end "&";
|
|
168
|
|
169 function "&"
|
|
170 (Left : Unbounded_Wide_Wide_String;
|
|
171 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
|
|
172 is
|
|
173 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
174 DL : constant Natural := LR.Last + 1;
|
|
175 DR : Shared_Wide_Wide_String_Access;
|
|
176
|
|
177 begin
|
|
178 DR := Allocate (DL);
|
|
179 DR.Data (1 .. LR.Last) := LR.Data (1 .. LR.Last);
|
|
180 DR.Data (DL) := Right;
|
|
181 DR.Last := DL;
|
|
182
|
|
183 return (AF.Controlled with Reference => DR);
|
|
184 end "&";
|
|
185
|
|
186 function "&"
|
|
187 (Left : Wide_Wide_Character;
|
|
188 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
189 is
|
|
190 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
191 DL : constant Natural := 1 + RR.Last;
|
|
192 DR : Shared_Wide_Wide_String_Access;
|
|
193
|
|
194 begin
|
|
195 DR := Allocate (DL);
|
|
196 DR.Data (1) := Left;
|
|
197 DR.Data (2 .. DL) := RR.Data (1 .. RR.Last);
|
|
198 DR.Last := DL;
|
|
199
|
|
200 return (AF.Controlled with Reference => DR);
|
|
201 end "&";
|
|
202
|
|
203 ---------
|
|
204 -- "*" --
|
|
205 ---------
|
|
206
|
|
207 function "*"
|
|
208 (Left : Natural;
|
|
209 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
|
|
210 is
|
|
211 DR : Shared_Wide_Wide_String_Access;
|
|
212
|
|
213 begin
|
|
214 -- Result is an empty string, reuse shared empty string
|
|
215
|
|
216 if Left = 0 then
|
|
217 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
218 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
219
|
|
220 -- Otherwise, allocate new shared string and fill it
|
|
221
|
|
222 else
|
|
223 DR := Allocate (Left);
|
|
224
|
|
225 for J in 1 .. Left loop
|
|
226 DR.Data (J) := Right;
|
|
227 end loop;
|
|
228
|
|
229 DR.Last := Left;
|
|
230 end if;
|
|
231
|
|
232 return (AF.Controlled with Reference => DR);
|
|
233 end "*";
|
|
234
|
|
235 function "*"
|
|
236 (Left : Natural;
|
|
237 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
238 is
|
|
239 DL : constant Natural := Left * Right'Length;
|
|
240 DR : Shared_Wide_Wide_String_Access;
|
|
241 K : Positive;
|
|
242
|
|
243 begin
|
|
244 -- Result is an empty string, reuse shared empty string
|
|
245
|
|
246 if DL = 0 then
|
|
247 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
248 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
249
|
|
250 -- Otherwise, allocate new shared string and fill it
|
|
251
|
|
252 else
|
|
253 DR := Allocate (DL);
|
|
254 K := 1;
|
|
255
|
|
256 for J in 1 .. Left loop
|
|
257 DR.Data (K .. K + Right'Length - 1) := Right;
|
|
258 K := K + Right'Length;
|
|
259 end loop;
|
|
260
|
|
261 DR.Last := DL;
|
|
262 end if;
|
|
263
|
|
264 return (AF.Controlled with Reference => DR);
|
|
265 end "*";
|
|
266
|
|
267 function "*"
|
|
268 (Left : Natural;
|
|
269 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
270 is
|
|
271 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
272 DL : constant Natural := Left * RR.Last;
|
|
273 DR : Shared_Wide_Wide_String_Access;
|
|
274 K : Positive;
|
|
275
|
|
276 begin
|
|
277 -- Result is an empty string, reuse shared empty string
|
|
278
|
|
279 if DL = 0 then
|
|
280 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
281 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
282
|
|
283 -- Coefficient is one, just return string itself
|
|
284
|
|
285 elsif Left = 1 then
|
|
286 Reference (RR);
|
|
287 DR := RR;
|
|
288
|
|
289 -- Otherwise, allocate new shared string and fill it
|
|
290
|
|
291 else
|
|
292 DR := Allocate (DL);
|
|
293 K := 1;
|
|
294
|
|
295 for J in 1 .. Left loop
|
|
296 DR.Data (K .. K + RR.Last - 1) := RR.Data (1 .. RR.Last);
|
|
297 K := K + RR.Last;
|
|
298 end loop;
|
|
299
|
|
300 DR.Last := DL;
|
|
301 end if;
|
|
302
|
|
303 return (AF.Controlled with Reference => DR);
|
|
304 end "*";
|
|
305
|
|
306 ---------
|
|
307 -- "<" --
|
|
308 ---------
|
|
309
|
|
310 function "<"
|
|
311 (Left : Unbounded_Wide_Wide_String;
|
|
312 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
313 is
|
|
314 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
315 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
316 begin
|
|
317 return LR.Data (1 .. LR.Last) < RR.Data (1 .. RR.Last);
|
|
318 end "<";
|
|
319
|
|
320 function "<"
|
|
321 (Left : Unbounded_Wide_Wide_String;
|
|
322 Right : Wide_Wide_String) return Boolean
|
|
323 is
|
|
324 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
325 begin
|
|
326 return LR.Data (1 .. LR.Last) < Right;
|
|
327 end "<";
|
|
328
|
|
329 function "<"
|
|
330 (Left : Wide_Wide_String;
|
|
331 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
332 is
|
|
333 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
334 begin
|
|
335 return Left < RR.Data (1 .. RR.Last);
|
|
336 end "<";
|
|
337
|
|
338 ----------
|
|
339 -- "<=" --
|
|
340 ----------
|
|
341
|
|
342 function "<="
|
|
343 (Left : Unbounded_Wide_Wide_String;
|
|
344 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
345 is
|
|
346 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
347 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
348
|
|
349 begin
|
|
350 -- LR = RR means two strings shares shared string, thus they are equal
|
|
351
|
|
352 return LR = RR or else LR.Data (1 .. LR.Last) <= RR.Data (1 .. RR.Last);
|
|
353 end "<=";
|
|
354
|
|
355 function "<="
|
|
356 (Left : Unbounded_Wide_Wide_String;
|
|
357 Right : Wide_Wide_String) return Boolean
|
|
358 is
|
|
359 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
360 begin
|
|
361 return LR.Data (1 .. LR.Last) <= Right;
|
|
362 end "<=";
|
|
363
|
|
364 function "<="
|
|
365 (Left : Wide_Wide_String;
|
|
366 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
367 is
|
|
368 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
369 begin
|
|
370 return Left <= RR.Data (1 .. RR.Last);
|
|
371 end "<=";
|
|
372
|
|
373 ---------
|
|
374 -- "=" --
|
|
375 ---------
|
|
376
|
|
377 function "="
|
|
378 (Left : Unbounded_Wide_Wide_String;
|
|
379 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
380 is
|
|
381 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
382 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
383
|
|
384 begin
|
|
385 return LR = RR or else LR.Data (1 .. LR.Last) = RR.Data (1 .. RR.Last);
|
|
386 -- LR = RR means two strings shares shared string, thus they are equal
|
|
387 end "=";
|
|
388
|
|
389 function "="
|
|
390 (Left : Unbounded_Wide_Wide_String;
|
|
391 Right : Wide_Wide_String) return Boolean
|
|
392 is
|
|
393 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
394 begin
|
|
395 return LR.Data (1 .. LR.Last) = Right;
|
|
396 end "=";
|
|
397
|
|
398 function "="
|
|
399 (Left : Wide_Wide_String;
|
|
400 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
401 is
|
|
402 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
403 begin
|
|
404 return Left = RR.Data (1 .. RR.Last);
|
|
405 end "=";
|
|
406
|
|
407 ---------
|
|
408 -- ">" --
|
|
409 ---------
|
|
410
|
|
411 function ">"
|
|
412 (Left : Unbounded_Wide_Wide_String;
|
|
413 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
414 is
|
|
415 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
416 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
417 begin
|
|
418 return LR.Data (1 .. LR.Last) > RR.Data (1 .. RR.Last);
|
|
419 end ">";
|
|
420
|
|
421 function ">"
|
|
422 (Left : Unbounded_Wide_Wide_String;
|
|
423 Right : Wide_Wide_String) return Boolean
|
|
424 is
|
|
425 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
426 begin
|
|
427 return LR.Data (1 .. LR.Last) > Right;
|
|
428 end ">";
|
|
429
|
|
430 function ">"
|
|
431 (Left : Wide_Wide_String;
|
|
432 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
433 is
|
|
434 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
435 begin
|
|
436 return Left > RR.Data (1 .. RR.Last);
|
|
437 end ">";
|
|
438
|
|
439 ----------
|
|
440 -- ">=" --
|
|
441 ----------
|
|
442
|
|
443 function ">="
|
|
444 (Left : Unbounded_Wide_Wide_String;
|
|
445 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
446 is
|
|
447 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
448 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
449
|
|
450 begin
|
|
451 -- LR = RR means two strings shares shared string, thus they are equal
|
|
452
|
|
453 return LR = RR or else LR.Data (1 .. LR.Last) >= RR.Data (1 .. RR.Last);
|
|
454 end ">=";
|
|
455
|
|
456 function ">="
|
|
457 (Left : Unbounded_Wide_Wide_String;
|
|
458 Right : Wide_Wide_String) return Boolean
|
|
459 is
|
|
460 LR : constant Shared_Wide_Wide_String_Access := Left.Reference;
|
|
461 begin
|
|
462 return LR.Data (1 .. LR.Last) >= Right;
|
|
463 end ">=";
|
|
464
|
|
465 function ">="
|
|
466 (Left : Wide_Wide_String;
|
|
467 Right : Unbounded_Wide_Wide_String) return Boolean
|
|
468 is
|
|
469 RR : constant Shared_Wide_Wide_String_Access := Right.Reference;
|
|
470 begin
|
|
471 return Left >= RR.Data (1 .. RR.Last);
|
|
472 end ">=";
|
|
473
|
|
474 ------------
|
|
475 -- Adjust --
|
|
476 ------------
|
|
477
|
|
478 procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
|
|
479 begin
|
|
480 Reference (Object.Reference);
|
|
481 end Adjust;
|
|
482
|
|
483 ------------------------
|
|
484 -- Aligned_Max_Length --
|
|
485 ------------------------
|
|
486
|
|
487 function Aligned_Max_Length (Max_Length : Natural) return Natural is
|
|
488 Static_Size : constant Natural :=
|
|
489 Empty_Shared_Wide_Wide_String'Size / Standard'Storage_Unit;
|
|
490 -- Total size of all static components
|
|
491
|
|
492 Element_Size : constant Natural :=
|
|
493 Wide_Wide_Character'Size / Standard'Storage_Unit;
|
|
494
|
|
495 begin
|
|
496 return
|
|
497 (((Static_Size + Max_Length * Element_Size - 1) / Min_Mul_Alloc + 2)
|
|
498 * Min_Mul_Alloc - Static_Size) / Element_Size;
|
|
499 end Aligned_Max_Length;
|
|
500
|
|
501 --------------
|
|
502 -- Allocate --
|
|
503 --------------
|
|
504
|
|
505 function Allocate
|
|
506 (Max_Length : Natural) return Shared_Wide_Wide_String_Access is
|
|
507 begin
|
|
508 -- Empty string requested, return shared empty string
|
|
509
|
|
510 if Max_Length = 0 then
|
|
511 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
512 return Empty_Shared_Wide_Wide_String'Access;
|
|
513
|
|
514 -- Otherwise, allocate requested space (and probably some more room)
|
|
515
|
|
516 else
|
|
517 return new Shared_Wide_Wide_String (Aligned_Max_Length (Max_Length));
|
|
518 end if;
|
|
519 end Allocate;
|
|
520
|
|
521 ------------
|
|
522 -- Append --
|
|
523 ------------
|
|
524
|
|
525 procedure Append
|
|
526 (Source : in out Unbounded_Wide_Wide_String;
|
|
527 New_Item : Unbounded_Wide_Wide_String)
|
|
528 is
|
|
529 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
530 NR : constant Shared_Wide_Wide_String_Access := New_Item.Reference;
|
|
531 DL : constant Natural := SR.Last + NR.Last;
|
|
532 DR : Shared_Wide_Wide_String_Access;
|
|
533
|
|
534 begin
|
|
535 -- Source is an empty string, reuse New_Item data
|
|
536
|
|
537 if SR.Last = 0 then
|
|
538 Reference (NR);
|
|
539 Source.Reference := NR;
|
|
540 Unreference (SR);
|
|
541
|
|
542 -- New_Item is empty string, nothing to do
|
|
543
|
|
544 elsif NR.Last = 0 then
|
|
545 null;
|
|
546
|
|
547 -- Try to reuse existent shared string
|
|
548
|
|
549 elsif Can_Be_Reused (SR, DL) then
|
|
550 SR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
|
|
551 SR.Last := DL;
|
|
552
|
|
553 -- Otherwise, allocate new one and fill it
|
|
554
|
|
555 else
|
|
556 DR := Allocate (DL + DL / Growth_Factor);
|
|
557 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
|
|
558 DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last);
|
|
559 DR.Last := DL;
|
|
560 Source.Reference := DR;
|
|
561 Unreference (SR);
|
|
562 end if;
|
|
563 end Append;
|
|
564
|
|
565 procedure Append
|
|
566 (Source : in out Unbounded_Wide_Wide_String;
|
|
567 New_Item : Wide_Wide_String)
|
|
568 is
|
|
569 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
570 DL : constant Natural := SR.Last + New_Item'Length;
|
|
571 DR : Shared_Wide_Wide_String_Access;
|
|
572
|
|
573 begin
|
|
574 -- New_Item is an empty string, nothing to do
|
|
575
|
|
576 if New_Item'Length = 0 then
|
|
577 null;
|
|
578
|
|
579 -- Try to reuse existing shared string
|
|
580
|
|
581 elsif Can_Be_Reused (SR, DL) then
|
|
582 SR.Data (SR.Last + 1 .. DL) := New_Item;
|
|
583 SR.Last := DL;
|
|
584
|
|
585 -- Otherwise, allocate new one and fill it
|
|
586
|
|
587 else
|
|
588 DR := Allocate (DL + DL / Growth_Factor);
|
|
589 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
|
|
590 DR.Data (SR.Last + 1 .. DL) := New_Item;
|
|
591 DR.Last := DL;
|
|
592 Source.Reference := DR;
|
|
593 Unreference (SR);
|
|
594 end if;
|
|
595 end Append;
|
|
596
|
|
597 procedure Append
|
|
598 (Source : in out Unbounded_Wide_Wide_String;
|
|
599 New_Item : Wide_Wide_Character)
|
|
600 is
|
|
601 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
602 DL : constant Natural := SR.Last + 1;
|
|
603 DR : Shared_Wide_Wide_String_Access;
|
|
604
|
|
605 begin
|
|
606 -- Try to reuse existing shared string
|
|
607
|
|
608 if Can_Be_Reused (SR, SR.Last + 1) then
|
|
609 SR.Data (SR.Last + 1) := New_Item;
|
|
610 SR.Last := SR.Last + 1;
|
|
611
|
|
612 -- Otherwise, allocate new one and fill it
|
|
613
|
|
614 else
|
|
615 DR := Allocate (DL + DL / Growth_Factor);
|
|
616 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
|
|
617 DR.Data (DL) := New_Item;
|
|
618 DR.Last := DL;
|
|
619 Source.Reference := DR;
|
|
620 Unreference (SR);
|
|
621 end if;
|
|
622 end Append;
|
|
623
|
|
624 -------------------
|
|
625 -- Can_Be_Reused --
|
|
626 -------------------
|
|
627
|
|
628 function Can_Be_Reused
|
|
629 (Item : Shared_Wide_Wide_String_Access;
|
|
630 Length : Natural) return Boolean is
|
|
631 begin
|
|
632 return
|
|
633 System.Atomic_Counters.Is_One (Item.Counter)
|
|
634 and then Item.Max_Length >= Length
|
|
635 and then Item.Max_Length <=
|
|
636 Aligned_Max_Length (Length + Length / Growth_Factor);
|
|
637 end Can_Be_Reused;
|
|
638
|
|
639 -----------
|
|
640 -- Count --
|
|
641 -----------
|
|
642
|
|
643 function Count
|
|
644 (Source : Unbounded_Wide_Wide_String;
|
|
645 Pattern : Wide_Wide_String;
|
|
646 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
|
|
647 Wide_Wide_Maps.Identity) return Natural
|
|
648 is
|
|
649 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
650 begin
|
|
651 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
|
|
652 end Count;
|
|
653
|
|
654 function Count
|
|
655 (Source : Unbounded_Wide_Wide_String;
|
|
656 Pattern : Wide_Wide_String;
|
|
657 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
|
|
658 return Natural
|
|
659 is
|
|
660 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
661 begin
|
|
662 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Pattern, Mapping);
|
|
663 end Count;
|
|
664
|
|
665 function Count
|
|
666 (Source : Unbounded_Wide_Wide_String;
|
|
667 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
|
|
668 is
|
|
669 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
670 begin
|
|
671 return Wide_Wide_Search.Count (SR.Data (1 .. SR.Last), Set);
|
|
672 end Count;
|
|
673
|
|
674 ------------
|
|
675 -- Delete --
|
|
676 ------------
|
|
677
|
|
678 function Delete
|
|
679 (Source : Unbounded_Wide_Wide_String;
|
|
680 From : Positive;
|
|
681 Through : Natural) return Unbounded_Wide_Wide_String
|
|
682 is
|
|
683 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
684 DL : Natural;
|
|
685 DR : Shared_Wide_Wide_String_Access;
|
|
686
|
|
687 begin
|
|
688 -- Empty slice is deleted, use the same shared string
|
|
689
|
|
690 if From > Through then
|
|
691 Reference (SR);
|
|
692 DR := SR;
|
|
693
|
|
694 -- Index is out of range
|
|
695
|
|
696 elsif Through > SR.Last then
|
|
697 raise Index_Error;
|
|
698
|
|
699 -- Compute size of the result
|
|
700
|
|
701 else
|
|
702 DL := SR.Last - (Through - From + 1);
|
|
703
|
|
704 -- Result is an empty string, reuse shared empty string
|
|
705
|
|
706 if DL = 0 then
|
|
707 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
708 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
709
|
|
710 -- Otherwise, allocate new shared string and fill it
|
|
711
|
|
712 else
|
|
713 DR := Allocate (DL);
|
|
714 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
|
|
715 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
|
|
716 DR.Last := DL;
|
|
717 end if;
|
|
718 end if;
|
|
719
|
|
720 return (AF.Controlled with Reference => DR);
|
|
721 end Delete;
|
|
722
|
|
723 procedure Delete
|
|
724 (Source : in out Unbounded_Wide_Wide_String;
|
|
725 From : Positive;
|
|
726 Through : Natural)
|
|
727 is
|
|
728 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
729 DL : Natural;
|
|
730 DR : Shared_Wide_Wide_String_Access;
|
|
731
|
|
732 begin
|
|
733 -- Nothing changed, return
|
|
734
|
|
735 if From > Through then
|
|
736 null;
|
|
737
|
|
738 -- Through is outside of the range
|
|
739
|
|
740 elsif Through > SR.Last then
|
|
741 raise Index_Error;
|
|
742
|
|
743 else
|
|
744 DL := SR.Last - (Through - From + 1);
|
|
745
|
|
746 -- Result is empty, reuse shared empty string
|
|
747
|
|
748 if DL = 0 then
|
|
749 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
750 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
751 Unreference (SR);
|
|
752
|
|
753 -- Try to reuse existent shared string
|
|
754
|
|
755 elsif Can_Be_Reused (SR, DL) then
|
|
756 SR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
|
|
757 SR.Last := DL;
|
|
758
|
|
759 -- Otherwise, allocate new shared string
|
|
760
|
|
761 else
|
|
762 DR := Allocate (DL);
|
|
763 DR.Data (1 .. From - 1) := SR.Data (1 .. From - 1);
|
|
764 DR.Data (From .. DL) := SR.Data (Through + 1 .. SR.Last);
|
|
765 DR.Last := DL;
|
|
766 Source.Reference := DR;
|
|
767 Unreference (SR);
|
|
768 end if;
|
|
769 end if;
|
|
770 end Delete;
|
|
771
|
|
772 -------------
|
|
773 -- Element --
|
|
774 -------------
|
|
775
|
|
776 function Element
|
|
777 (Source : Unbounded_Wide_Wide_String;
|
|
778 Index : Positive) return Wide_Wide_Character
|
|
779 is
|
|
780 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
781 begin
|
|
782 if Index <= SR.Last then
|
|
783 return SR.Data (Index);
|
|
784 else
|
|
785 raise Index_Error;
|
|
786 end if;
|
|
787 end Element;
|
|
788
|
|
789 --------------
|
|
790 -- Finalize --
|
|
791 --------------
|
|
792
|
|
793 procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
|
|
794 SR : constant Shared_Wide_Wide_String_Access := Object.Reference;
|
|
795
|
|
796 begin
|
|
797 if SR /= null then
|
|
798
|
|
799 -- The same controlled object can be finalized several times for
|
|
800 -- some reason. As per 7.6.1(24) this should have no ill effect,
|
|
801 -- so we need to add a guard for the case of finalizing the same
|
|
802 -- object twice.
|
|
803
|
|
804 Object.Reference := null;
|
|
805 Unreference (SR);
|
|
806 end if;
|
|
807 end Finalize;
|
|
808
|
|
809 ----------------
|
|
810 -- Find_Token --
|
|
811 ----------------
|
|
812
|
|
813 procedure Find_Token
|
|
814 (Source : Unbounded_Wide_Wide_String;
|
|
815 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
|
|
816 From : Positive;
|
|
817 Test : Strings.Membership;
|
|
818 First : out Positive;
|
|
819 Last : out Natural)
|
|
820 is
|
|
821 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
822 begin
|
|
823 Wide_Wide_Search.Find_Token
|
|
824 (SR.Data (From .. SR.Last), Set, Test, First, Last);
|
|
825 end Find_Token;
|
|
826
|
|
827 procedure Find_Token
|
|
828 (Source : Unbounded_Wide_Wide_String;
|
|
829 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
|
|
830 Test : Strings.Membership;
|
|
831 First : out Positive;
|
|
832 Last : out Natural)
|
|
833 is
|
|
834 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
835 begin
|
|
836 Wide_Wide_Search.Find_Token
|
|
837 (SR.Data (1 .. SR.Last), Set, Test, First, Last);
|
|
838 end Find_Token;
|
|
839
|
|
840 ----------
|
|
841 -- Free --
|
|
842 ----------
|
|
843
|
|
844 procedure Free (X : in out Wide_Wide_String_Access) is
|
|
845 procedure Deallocate is
|
|
846 new Ada.Unchecked_Deallocation
|
|
847 (Wide_Wide_String, Wide_Wide_String_Access);
|
|
848 begin
|
|
849 Deallocate (X);
|
|
850 end Free;
|
|
851
|
|
852 ----------
|
|
853 -- Head --
|
|
854 ----------
|
|
855
|
|
856 function Head
|
|
857 (Source : Unbounded_Wide_Wide_String;
|
|
858 Count : Natural;
|
|
859 Pad : Wide_Wide_Character := Wide_Wide_Space)
|
|
860 return Unbounded_Wide_Wide_String
|
|
861 is
|
|
862 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
863 DR : Shared_Wide_Wide_String_Access;
|
|
864
|
|
865 begin
|
|
866 -- Result is empty, reuse shared empty string
|
|
867
|
|
868 if Count = 0 then
|
|
869 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
870 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
871
|
|
872 -- Length of the string is the same as requested, reuse source shared
|
|
873 -- string.
|
|
874
|
|
875 elsif Count = SR.Last then
|
|
876 Reference (SR);
|
|
877 DR := SR;
|
|
878
|
|
879 -- Otherwise, allocate new shared string and fill it
|
|
880
|
|
881 else
|
|
882 DR := Allocate (Count);
|
|
883
|
|
884 -- Length of the source string is more than requested, copy
|
|
885 -- corresponding slice.
|
|
886
|
|
887 if Count < SR.Last then
|
|
888 DR.Data (1 .. Count) := SR.Data (1 .. Count);
|
|
889
|
|
890 -- Length of the source string is less than requested, copy all
|
|
891 -- contents and fill others by Pad character.
|
|
892
|
|
893 else
|
|
894 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
|
|
895
|
|
896 for J in SR.Last + 1 .. Count loop
|
|
897 DR.Data (J) := Pad;
|
|
898 end loop;
|
|
899 end if;
|
|
900
|
|
901 DR.Last := Count;
|
|
902 end if;
|
|
903
|
|
904 return (AF.Controlled with Reference => DR);
|
|
905 end Head;
|
|
906
|
|
907 procedure Head
|
|
908 (Source : in out Unbounded_Wide_Wide_String;
|
|
909 Count : Natural;
|
|
910 Pad : Wide_Wide_Character := Wide_Wide_Space)
|
|
911 is
|
|
912 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
913 DR : Shared_Wide_Wide_String_Access;
|
|
914
|
|
915 begin
|
|
916 -- Result is empty, reuse empty shared string
|
|
917
|
|
918 if Count = 0 then
|
|
919 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
920 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
921 Unreference (SR);
|
|
922
|
|
923 -- Result is same with source string, reuse source shared string
|
|
924
|
|
925 elsif Count = SR.Last then
|
|
926 null;
|
|
927
|
|
928 -- Try to reuse existent shared string
|
|
929
|
|
930 elsif Can_Be_Reused (SR, Count) then
|
|
931 if Count > SR.Last then
|
|
932 for J in SR.Last + 1 .. Count loop
|
|
933 SR.Data (J) := Pad;
|
|
934 end loop;
|
|
935 end if;
|
|
936
|
|
937 SR.Last := Count;
|
|
938
|
|
939 -- Otherwise, allocate new shared string and fill it
|
|
940
|
|
941 else
|
|
942 DR := Allocate (Count);
|
|
943
|
|
944 -- Length of the source string is greater than requested, copy
|
|
945 -- corresponding slice.
|
|
946
|
|
947 if Count < SR.Last then
|
|
948 DR.Data (1 .. Count) := SR.Data (1 .. Count);
|
|
949
|
|
950 -- Length of the source string is less than requested, copy all
|
|
951 -- exists data and fill others by Pad character.
|
|
952
|
|
953 else
|
|
954 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
|
|
955
|
|
956 for J in SR.Last + 1 .. Count loop
|
|
957 DR.Data (J) := Pad;
|
|
958 end loop;
|
|
959 end if;
|
|
960
|
|
961 DR.Last := Count;
|
|
962 Source.Reference := DR;
|
|
963 Unreference (SR);
|
|
964 end if;
|
|
965 end Head;
|
|
966
|
|
967 -----------
|
|
968 -- Index --
|
|
969 -----------
|
|
970
|
|
971 function Index
|
|
972 (Source : Unbounded_Wide_Wide_String;
|
|
973 Pattern : Wide_Wide_String;
|
|
974 Going : Strings.Direction := Strings.Forward;
|
|
975 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
|
|
976 Wide_Wide_Maps.Identity) return Natural
|
|
977 is
|
|
978 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
979 begin
|
|
980 return Wide_Wide_Search.Index
|
|
981 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
|
|
982 end Index;
|
|
983
|
|
984 function Index
|
|
985 (Source : Unbounded_Wide_Wide_String;
|
|
986 Pattern : Wide_Wide_String;
|
|
987 Going : Direction := Forward;
|
|
988 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
|
|
989 return Natural
|
|
990 is
|
|
991 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
992 begin
|
|
993 return Wide_Wide_Search.Index
|
|
994 (SR.Data (1 .. SR.Last), Pattern, Going, Mapping);
|
|
995 end Index;
|
|
996
|
|
997 function Index
|
|
998 (Source : Unbounded_Wide_Wide_String;
|
|
999 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
|
|
1000 Test : Strings.Membership := Strings.Inside;
|
|
1001 Going : Strings.Direction := Strings.Forward) return Natural
|
|
1002 is
|
|
1003 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1004 begin
|
|
1005 return Wide_Wide_Search.Index (SR.Data (1 .. SR.Last), Set, Test, Going);
|
|
1006 end Index;
|
|
1007
|
|
1008 function Index
|
|
1009 (Source : Unbounded_Wide_Wide_String;
|
|
1010 Pattern : Wide_Wide_String;
|
|
1011 From : Positive;
|
|
1012 Going : Direction := Forward;
|
|
1013 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
|
|
1014 Wide_Wide_Maps.Identity) return Natural
|
|
1015 is
|
|
1016 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1017 begin
|
|
1018 return Wide_Wide_Search.Index
|
|
1019 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
|
|
1020 end Index;
|
|
1021
|
|
1022 function Index
|
|
1023 (Source : Unbounded_Wide_Wide_String;
|
|
1024 Pattern : Wide_Wide_String;
|
|
1025 From : Positive;
|
|
1026 Going : Direction := Forward;
|
|
1027 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
|
|
1028 return Natural
|
|
1029 is
|
|
1030 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1031 begin
|
|
1032 return Wide_Wide_Search.Index
|
|
1033 (SR.Data (1 .. SR.Last), Pattern, From, Going, Mapping);
|
|
1034 end Index;
|
|
1035
|
|
1036 function Index
|
|
1037 (Source : Unbounded_Wide_Wide_String;
|
|
1038 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
|
|
1039 From : Positive;
|
|
1040 Test : Membership := Inside;
|
|
1041 Going : Direction := Forward) return Natural
|
|
1042 is
|
|
1043 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1044 begin
|
|
1045 return Wide_Wide_Search.Index
|
|
1046 (SR.Data (1 .. SR.Last), Set, From, Test, Going);
|
|
1047 end Index;
|
|
1048
|
|
1049 ---------------------
|
|
1050 -- Index_Non_Blank --
|
|
1051 ---------------------
|
|
1052
|
|
1053 function Index_Non_Blank
|
|
1054 (Source : Unbounded_Wide_Wide_String;
|
|
1055 Going : Strings.Direction := Strings.Forward) return Natural
|
|
1056 is
|
|
1057 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1058 begin
|
|
1059 return Wide_Wide_Search.Index_Non_Blank (SR.Data (1 .. SR.Last), Going);
|
|
1060 end Index_Non_Blank;
|
|
1061
|
|
1062 function Index_Non_Blank
|
|
1063 (Source : Unbounded_Wide_Wide_String;
|
|
1064 From : Positive;
|
|
1065 Going : Direction := Forward) return Natural
|
|
1066 is
|
|
1067 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1068 begin
|
|
1069 return Wide_Wide_Search.Index_Non_Blank
|
|
1070 (SR.Data (1 .. SR.Last), From, Going);
|
|
1071 end Index_Non_Blank;
|
|
1072
|
|
1073 ----------------
|
|
1074 -- Initialize --
|
|
1075 ----------------
|
|
1076
|
|
1077 procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
|
|
1078 begin
|
|
1079 Reference (Object.Reference);
|
|
1080 end Initialize;
|
|
1081
|
|
1082 ------------
|
|
1083 -- Insert --
|
|
1084 ------------
|
|
1085
|
|
1086 function Insert
|
|
1087 (Source : Unbounded_Wide_Wide_String;
|
|
1088 Before : Positive;
|
|
1089 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
1090 is
|
|
1091 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1092 DL : constant Natural := SR.Last + New_Item'Length;
|
|
1093 DR : Shared_Wide_Wide_String_Access;
|
|
1094
|
|
1095 begin
|
|
1096 -- Check index first
|
|
1097
|
|
1098 if Before > SR.Last + 1 then
|
|
1099 raise Index_Error;
|
|
1100 end if;
|
|
1101
|
|
1102 -- Result is empty, reuse empty shared string
|
|
1103
|
|
1104 if DL = 0 then
|
|
1105 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1106 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1107
|
|
1108 -- Inserted string is empty, reuse source shared string
|
|
1109
|
|
1110 elsif New_Item'Length = 0 then
|
|
1111 Reference (SR);
|
|
1112 DR := SR;
|
|
1113
|
|
1114 -- Otherwise, allocate new shared string and fill it
|
|
1115
|
|
1116 else
|
|
1117 DR := Allocate (DL + DL / Growth_Factor);
|
|
1118 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
|
|
1119 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
|
|
1120 DR.Data (Before + New_Item'Length .. DL) :=
|
|
1121 SR.Data (Before .. SR.Last);
|
|
1122 DR.Last := DL;
|
|
1123 end if;
|
|
1124
|
|
1125 return (AF.Controlled with Reference => DR);
|
|
1126 end Insert;
|
|
1127
|
|
1128 procedure Insert
|
|
1129 (Source : in out Unbounded_Wide_Wide_String;
|
|
1130 Before : Positive;
|
|
1131 New_Item : Wide_Wide_String)
|
|
1132 is
|
|
1133 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1134 DL : constant Natural := SR.Last + New_Item'Length;
|
|
1135 DR : Shared_Wide_Wide_String_Access;
|
|
1136
|
|
1137 begin
|
|
1138 -- Check bounds
|
|
1139
|
|
1140 if Before > SR.Last + 1 then
|
|
1141 raise Index_Error;
|
|
1142 end if;
|
|
1143
|
|
1144 -- Result is empty string, reuse empty shared string
|
|
1145
|
|
1146 if DL = 0 then
|
|
1147 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1148 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1149 Unreference (SR);
|
|
1150
|
|
1151 -- Inserted string is empty, nothing to do
|
|
1152
|
|
1153 elsif New_Item'Length = 0 then
|
|
1154 null;
|
|
1155
|
|
1156 -- Try to reuse existent shared string first
|
|
1157
|
|
1158 elsif Can_Be_Reused (SR, DL) then
|
|
1159 SR.Data (Before + New_Item'Length .. DL) :=
|
|
1160 SR.Data (Before .. SR.Last);
|
|
1161 SR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
|
|
1162 SR.Last := DL;
|
|
1163
|
|
1164 -- Otherwise, allocate new shared string and fill it
|
|
1165
|
|
1166 else
|
|
1167 DR := Allocate (DL + DL / Growth_Factor);
|
|
1168 DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1);
|
|
1169 DR.Data (Before .. Before + New_Item'Length - 1) := New_Item;
|
|
1170 DR.Data (Before + New_Item'Length .. DL) :=
|
|
1171 SR.Data (Before .. SR.Last);
|
|
1172 DR.Last := DL;
|
|
1173 Source.Reference := DR;
|
|
1174 Unreference (SR);
|
|
1175 end if;
|
|
1176 end Insert;
|
|
1177
|
|
1178 ------------
|
|
1179 -- Length --
|
|
1180 ------------
|
|
1181
|
|
1182 function Length (Source : Unbounded_Wide_Wide_String) return Natural is
|
|
1183 begin
|
|
1184 return Source.Reference.Last;
|
|
1185 end Length;
|
|
1186
|
|
1187 ---------------
|
|
1188 -- Overwrite --
|
|
1189 ---------------
|
|
1190
|
|
1191 function Overwrite
|
|
1192 (Source : Unbounded_Wide_Wide_String;
|
|
1193 Position : Positive;
|
|
1194 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
1195 is
|
|
1196 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1197 DL : Natural;
|
|
1198 DR : Shared_Wide_Wide_String_Access;
|
|
1199
|
|
1200 begin
|
|
1201 -- Check bounds
|
|
1202
|
|
1203 if Position > SR.Last + 1 then
|
|
1204 raise Index_Error;
|
|
1205 end if;
|
|
1206
|
|
1207 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
|
|
1208
|
|
1209 -- Result is empty string, reuse empty shared string
|
|
1210
|
|
1211 if DL = 0 then
|
|
1212 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1213 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1214
|
|
1215 -- Result is same with source string, reuse source shared string
|
|
1216
|
|
1217 elsif New_Item'Length = 0 then
|
|
1218 Reference (SR);
|
|
1219 DR := SR;
|
|
1220
|
|
1221 -- Otherwise, allocate new shared string and fill it
|
|
1222
|
|
1223 else
|
|
1224 DR := Allocate (DL);
|
|
1225 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
|
|
1226 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
|
|
1227 DR.Data (Position + New_Item'Length .. DL) :=
|
|
1228 SR.Data (Position + New_Item'Length .. SR.Last);
|
|
1229 DR.Last := DL;
|
|
1230 end if;
|
|
1231
|
|
1232 return (AF.Controlled with Reference => DR);
|
|
1233 end Overwrite;
|
|
1234
|
|
1235 procedure Overwrite
|
|
1236 (Source : in out Unbounded_Wide_Wide_String;
|
|
1237 Position : Positive;
|
|
1238 New_Item : Wide_Wide_String)
|
|
1239 is
|
|
1240 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1241 DL : Natural;
|
|
1242 DR : Shared_Wide_Wide_String_Access;
|
|
1243
|
|
1244 begin
|
|
1245 -- Bounds check
|
|
1246
|
|
1247 if Position > SR.Last + 1 then
|
|
1248 raise Index_Error;
|
|
1249 end if;
|
|
1250
|
|
1251 DL := Integer'Max (SR.Last, Position + New_Item'Length - 1);
|
|
1252
|
|
1253 -- Result is empty string, reuse empty shared string
|
|
1254
|
|
1255 if DL = 0 then
|
|
1256 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1257 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1258 Unreference (SR);
|
|
1259
|
|
1260 -- String unchanged, nothing to do
|
|
1261
|
|
1262 elsif New_Item'Length = 0 then
|
|
1263 null;
|
|
1264
|
|
1265 -- Try to reuse existent shared string
|
|
1266
|
|
1267 elsif Can_Be_Reused (SR, DL) then
|
|
1268 SR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
|
|
1269 SR.Last := DL;
|
|
1270
|
|
1271 -- Otherwise allocate new shared string and fill it
|
|
1272
|
|
1273 else
|
|
1274 DR := Allocate (DL);
|
|
1275 DR.Data (1 .. Position - 1) := SR.Data (1 .. Position - 1);
|
|
1276 DR.Data (Position .. Position + New_Item'Length - 1) := New_Item;
|
|
1277 DR.Data (Position + New_Item'Length .. DL) :=
|
|
1278 SR.Data (Position + New_Item'Length .. SR.Last);
|
|
1279 DR.Last := DL;
|
|
1280 Source.Reference := DR;
|
|
1281 Unreference (SR);
|
|
1282 end if;
|
|
1283 end Overwrite;
|
|
1284
|
|
1285 ---------------
|
|
1286 -- Reference --
|
|
1287 ---------------
|
|
1288
|
|
1289 procedure Reference (Item : not null Shared_Wide_Wide_String_Access) is
|
|
1290 begin
|
|
1291 System.Atomic_Counters.Increment (Item.Counter);
|
|
1292 end Reference;
|
|
1293
|
|
1294 ---------------------
|
|
1295 -- Replace_Element --
|
|
1296 ---------------------
|
|
1297
|
|
1298 procedure Replace_Element
|
|
1299 (Source : in out Unbounded_Wide_Wide_String;
|
|
1300 Index : Positive;
|
|
1301 By : Wide_Wide_Character)
|
|
1302 is
|
|
1303 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1304 DR : Shared_Wide_Wide_String_Access;
|
|
1305
|
|
1306 begin
|
|
1307 -- Bounds check
|
|
1308
|
|
1309 if Index <= SR.Last then
|
|
1310
|
|
1311 -- Try to reuse existent shared string
|
|
1312
|
|
1313 if Can_Be_Reused (SR, SR.Last) then
|
|
1314 SR.Data (Index) := By;
|
|
1315
|
|
1316 -- Otherwise allocate new shared string and fill it
|
|
1317
|
|
1318 else
|
|
1319 DR := Allocate (SR.Last);
|
|
1320 DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last);
|
|
1321 DR.Data (Index) := By;
|
|
1322 DR.Last := SR.Last;
|
|
1323 Source.Reference := DR;
|
|
1324 Unreference (SR);
|
|
1325 end if;
|
|
1326
|
|
1327 else
|
|
1328 raise Index_Error;
|
|
1329 end if;
|
|
1330 end Replace_Element;
|
|
1331
|
|
1332 -------------------
|
|
1333 -- Replace_Slice --
|
|
1334 -------------------
|
|
1335
|
|
1336 function Replace_Slice
|
|
1337 (Source : Unbounded_Wide_Wide_String;
|
|
1338 Low : Positive;
|
|
1339 High : Natural;
|
|
1340 By : Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
1341 is
|
|
1342 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1343 DL : Natural;
|
|
1344 DR : Shared_Wide_Wide_String_Access;
|
|
1345
|
|
1346 begin
|
|
1347 -- Check bounds
|
|
1348
|
|
1349 if Low > SR.Last + 1 then
|
|
1350 raise Index_Error;
|
|
1351 end if;
|
|
1352
|
|
1353 -- Do replace operation when removed slice is not empty
|
|
1354
|
|
1355 if High >= Low then
|
|
1356 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
|
|
1357 -- This is the number of characters remaining in the string after
|
|
1358 -- replacing the slice.
|
|
1359
|
|
1360 -- Result is empty string, reuse empty shared string
|
|
1361
|
|
1362 if DL = 0 then
|
|
1363 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1364 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1365
|
|
1366 -- Otherwise allocate new shared string and fill it
|
|
1367
|
|
1368 else
|
|
1369 DR := Allocate (DL);
|
|
1370 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
|
|
1371 DR.Data (Low .. Low + By'Length - 1) := By;
|
|
1372 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
|
|
1373 DR.Last := DL;
|
|
1374 end if;
|
|
1375
|
|
1376 return (AF.Controlled with Reference => DR);
|
|
1377
|
|
1378 -- Otherwise just insert string
|
|
1379
|
|
1380 else
|
|
1381 return Insert (Source, Low, By);
|
|
1382 end if;
|
|
1383 end Replace_Slice;
|
|
1384
|
|
1385 procedure Replace_Slice
|
|
1386 (Source : in out Unbounded_Wide_Wide_String;
|
|
1387 Low : Positive;
|
|
1388 High : Natural;
|
|
1389 By : Wide_Wide_String)
|
|
1390 is
|
|
1391 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1392 DL : Natural;
|
|
1393 DR : Shared_Wide_Wide_String_Access;
|
|
1394
|
|
1395 begin
|
|
1396 -- Bounds check
|
|
1397
|
|
1398 if Low > SR.Last + 1 then
|
|
1399 raise Index_Error;
|
|
1400 end if;
|
|
1401
|
|
1402 -- Do replace operation only when replaced slice is not empty
|
|
1403
|
|
1404 if High >= Low then
|
|
1405 DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1;
|
|
1406 -- This is the number of characters remaining in the string after
|
|
1407 -- replacing the slice.
|
|
1408
|
|
1409 -- Result is empty string, reuse empty shared string
|
|
1410
|
|
1411 if DL = 0 then
|
|
1412 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1413 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1414 Unreference (SR);
|
|
1415
|
|
1416 -- Try to reuse existent shared string
|
|
1417
|
|
1418 elsif Can_Be_Reused (SR, DL) then
|
|
1419 SR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
|
|
1420 SR.Data (Low .. Low + By'Length - 1) := By;
|
|
1421 SR.Last := DL;
|
|
1422
|
|
1423 -- Otherwise allocate new shared string and fill it
|
|
1424
|
|
1425 else
|
|
1426 DR := Allocate (DL);
|
|
1427 DR.Data (1 .. Low - 1) := SR.Data (1 .. Low - 1);
|
|
1428 DR.Data (Low .. Low + By'Length - 1) := By;
|
|
1429 DR.Data (Low + By'Length .. DL) := SR.Data (High + 1 .. SR.Last);
|
|
1430 DR.Last := DL;
|
|
1431 Source.Reference := DR;
|
|
1432 Unreference (SR);
|
|
1433 end if;
|
|
1434
|
|
1435 -- Otherwise just insert item
|
|
1436
|
|
1437 else
|
|
1438 Insert (Source, Low, By);
|
|
1439 end if;
|
|
1440 end Replace_Slice;
|
|
1441
|
|
1442 -------------------------------
|
|
1443 -- Set_Unbounded_Wide_Wide_String --
|
|
1444 -------------------------------
|
|
1445
|
|
1446 procedure Set_Unbounded_Wide_Wide_String
|
|
1447 (Target : out Unbounded_Wide_Wide_String;
|
|
1448 Source : Wide_Wide_String)
|
|
1449 is
|
|
1450 TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
|
|
1451 DR : Shared_Wide_Wide_String_Access;
|
|
1452
|
|
1453 begin
|
|
1454 -- In case of empty string, reuse empty shared string
|
|
1455
|
|
1456 if Source'Length = 0 then
|
|
1457 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1458 Target.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1459
|
|
1460 else
|
|
1461 -- Try to reuse existent shared string
|
|
1462
|
|
1463 if Can_Be_Reused (TR, Source'Length) then
|
|
1464 Reference (TR);
|
|
1465 DR := TR;
|
|
1466
|
|
1467 -- Otherwise allocate new shared string
|
|
1468
|
|
1469 else
|
|
1470 DR := Allocate (Source'Length);
|
|
1471 Target.Reference := DR;
|
|
1472 end if;
|
|
1473
|
|
1474 DR.Data (1 .. Source'Length) := Source;
|
|
1475 DR.Last := Source'Length;
|
|
1476 end if;
|
|
1477
|
|
1478 Unreference (TR);
|
|
1479 end Set_Unbounded_Wide_Wide_String;
|
|
1480
|
|
1481 -----------
|
|
1482 -- Slice --
|
|
1483 -----------
|
|
1484
|
|
1485 function Slice
|
|
1486 (Source : Unbounded_Wide_Wide_String;
|
|
1487 Low : Positive;
|
|
1488 High : Natural) return Wide_Wide_String
|
|
1489 is
|
|
1490 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1491
|
|
1492 begin
|
|
1493 -- Note: test of High > Length is in accordance with AI95-00128
|
|
1494
|
|
1495 if Low > SR.Last + 1 or else High > SR.Last then
|
|
1496 raise Index_Error;
|
|
1497
|
|
1498 else
|
|
1499 return SR.Data (Low .. High);
|
|
1500 end if;
|
|
1501 end Slice;
|
|
1502
|
|
1503 ----------
|
|
1504 -- Tail --
|
|
1505 ----------
|
|
1506
|
|
1507 function Tail
|
|
1508 (Source : Unbounded_Wide_Wide_String;
|
|
1509 Count : Natural;
|
|
1510 Pad : Wide_Wide_Character := Wide_Wide_Space)
|
|
1511 return Unbounded_Wide_Wide_String
|
|
1512 is
|
|
1513 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1514 DR : Shared_Wide_Wide_String_Access;
|
|
1515
|
|
1516 begin
|
|
1517 -- For empty result reuse empty shared string
|
|
1518
|
|
1519 if Count = 0 then
|
|
1520 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1521 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1522
|
|
1523 -- Result is hole source string, reuse source shared string
|
|
1524
|
|
1525 elsif Count = SR.Last then
|
|
1526 Reference (SR);
|
|
1527 DR := SR;
|
|
1528
|
|
1529 -- Otherwise allocate new shared string and fill it
|
|
1530
|
|
1531 else
|
|
1532 DR := Allocate (Count);
|
|
1533
|
|
1534 if Count < SR.Last then
|
|
1535 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
|
|
1536
|
|
1537 else
|
|
1538 for J in 1 .. Count - SR.Last loop
|
|
1539 DR.Data (J) := Pad;
|
|
1540 end loop;
|
|
1541
|
|
1542 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
|
|
1543 end if;
|
|
1544
|
|
1545 DR.Last := Count;
|
|
1546 end if;
|
|
1547
|
|
1548 return (AF.Controlled with Reference => DR);
|
|
1549 end Tail;
|
|
1550
|
|
1551 procedure Tail
|
|
1552 (Source : in out Unbounded_Wide_Wide_String;
|
|
1553 Count : Natural;
|
|
1554 Pad : Wide_Wide_Character := Wide_Wide_Space)
|
|
1555 is
|
|
1556 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1557 DR : Shared_Wide_Wide_String_Access;
|
|
1558
|
|
1559 procedure Common
|
|
1560 (SR : Shared_Wide_Wide_String_Access;
|
|
1561 DR : Shared_Wide_Wide_String_Access;
|
|
1562 Count : Natural);
|
|
1563 -- Common code of tail computation. SR/DR can point to the same object
|
|
1564
|
|
1565 ------------
|
|
1566 -- Common --
|
|
1567 ------------
|
|
1568
|
|
1569 procedure Common
|
|
1570 (SR : Shared_Wide_Wide_String_Access;
|
|
1571 DR : Shared_Wide_Wide_String_Access;
|
|
1572 Count : Natural) is
|
|
1573 begin
|
|
1574 if Count < SR.Last then
|
|
1575 DR.Data (1 .. Count) := SR.Data (SR.Last - Count + 1 .. SR.Last);
|
|
1576
|
|
1577 else
|
|
1578 DR.Data (Count - SR.Last + 1 .. Count) := SR.Data (1 .. SR.Last);
|
|
1579
|
|
1580 for J in 1 .. Count - SR.Last loop
|
|
1581 DR.Data (J) := Pad;
|
|
1582 end loop;
|
|
1583 end if;
|
|
1584
|
|
1585 DR.Last := Count;
|
|
1586 end Common;
|
|
1587
|
|
1588 begin
|
|
1589 -- Result is empty string, reuse empty shared string
|
|
1590
|
|
1591 if Count = 0 then
|
|
1592 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1593 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1594 Unreference (SR);
|
|
1595
|
|
1596 -- Length of the result is the same with length of the source string,
|
|
1597 -- reuse source shared string.
|
|
1598
|
|
1599 elsif Count = SR.Last then
|
|
1600 null;
|
|
1601
|
|
1602 -- Try to reuse existent shared string
|
|
1603
|
|
1604 elsif Can_Be_Reused (SR, Count) then
|
|
1605 Common (SR, SR, Count);
|
|
1606
|
|
1607 -- Otherwise allocate new shared string and fill it
|
|
1608
|
|
1609 else
|
|
1610 DR := Allocate (Count);
|
|
1611 Common (SR, DR, Count);
|
|
1612 Source.Reference := DR;
|
|
1613 Unreference (SR);
|
|
1614 end if;
|
|
1615 end Tail;
|
|
1616
|
|
1617 -------------------------
|
|
1618 -- To_Wide_Wide_String --
|
|
1619 -------------------------
|
|
1620
|
|
1621 function To_Wide_Wide_String
|
|
1622 (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String is
|
|
1623 begin
|
|
1624 return Source.Reference.Data (1 .. Source.Reference.Last);
|
|
1625 end To_Wide_Wide_String;
|
|
1626
|
|
1627 -----------------------------------
|
|
1628 -- To_Unbounded_Wide_Wide_String --
|
|
1629 -----------------------------------
|
|
1630
|
|
1631 function To_Unbounded_Wide_Wide_String
|
|
1632 (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
|
|
1633 is
|
|
1634 DR : Shared_Wide_Wide_String_Access;
|
|
1635
|
|
1636 begin
|
|
1637 if Source'Length = 0 then
|
|
1638 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1639 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1640
|
|
1641 else
|
|
1642 DR := Allocate (Source'Length);
|
|
1643 DR.Data (1 .. Source'Length) := Source;
|
|
1644 DR.Last := Source'Length;
|
|
1645 end if;
|
|
1646
|
|
1647 return (AF.Controlled with Reference => DR);
|
|
1648 end To_Unbounded_Wide_Wide_String;
|
|
1649
|
|
1650 function To_Unbounded_Wide_Wide_String
|
|
1651 (Length : Natural) return Unbounded_Wide_Wide_String
|
|
1652 is
|
|
1653 DR : Shared_Wide_Wide_String_Access;
|
|
1654
|
|
1655 begin
|
|
1656 if Length = 0 then
|
|
1657 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1658 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1659
|
|
1660 else
|
|
1661 DR := Allocate (Length);
|
|
1662 DR.Last := Length;
|
|
1663 end if;
|
|
1664
|
|
1665 return (AF.Controlled with Reference => DR);
|
|
1666 end To_Unbounded_Wide_Wide_String;
|
|
1667
|
|
1668 ---------------
|
|
1669 -- Translate --
|
|
1670 ---------------
|
|
1671
|
|
1672 function Translate
|
|
1673 (Source : Unbounded_Wide_Wide_String;
|
|
1674 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
|
|
1675 return Unbounded_Wide_Wide_String
|
|
1676 is
|
|
1677 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1678 DR : Shared_Wide_Wide_String_Access;
|
|
1679
|
|
1680 begin
|
|
1681 -- Nothing to translate, reuse empty shared string
|
|
1682
|
|
1683 if SR.Last = 0 then
|
|
1684 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1685 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1686
|
|
1687 -- Otherwise, allocate new shared string and fill it
|
|
1688
|
|
1689 else
|
|
1690 DR := Allocate (SR.Last);
|
|
1691
|
|
1692 for J in 1 .. SR.Last loop
|
|
1693 DR.Data (J) := Value (Mapping, SR.Data (J));
|
|
1694 end loop;
|
|
1695
|
|
1696 DR.Last := SR.Last;
|
|
1697 end if;
|
|
1698
|
|
1699 return (AF.Controlled with Reference => DR);
|
|
1700 end Translate;
|
|
1701
|
|
1702 procedure Translate
|
|
1703 (Source : in out Unbounded_Wide_Wide_String;
|
|
1704 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
|
|
1705 is
|
|
1706 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1707 DR : Shared_Wide_Wide_String_Access;
|
|
1708
|
|
1709 begin
|
|
1710 -- Nothing to translate
|
|
1711
|
|
1712 if SR.Last = 0 then
|
|
1713 null;
|
|
1714
|
|
1715 -- Try to reuse shared string
|
|
1716
|
|
1717 elsif Can_Be_Reused (SR, SR.Last) then
|
|
1718 for J in 1 .. SR.Last loop
|
|
1719 SR.Data (J) := Value (Mapping, SR.Data (J));
|
|
1720 end loop;
|
|
1721
|
|
1722 -- Otherwise, allocate new shared string
|
|
1723
|
|
1724 else
|
|
1725 DR := Allocate (SR.Last);
|
|
1726
|
|
1727 for J in 1 .. SR.Last loop
|
|
1728 DR.Data (J) := Value (Mapping, SR.Data (J));
|
|
1729 end loop;
|
|
1730
|
|
1731 DR.Last := SR.Last;
|
|
1732 Source.Reference := DR;
|
|
1733 Unreference (SR);
|
|
1734 end if;
|
|
1735 end Translate;
|
|
1736
|
|
1737 function Translate
|
|
1738 (Source : Unbounded_Wide_Wide_String;
|
|
1739 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
|
|
1740 return Unbounded_Wide_Wide_String
|
|
1741 is
|
|
1742 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1743 DR : Shared_Wide_Wide_String_Access;
|
|
1744
|
|
1745 begin
|
|
1746 -- Nothing to translate, reuse empty shared string
|
|
1747
|
|
1748 if SR.Last = 0 then
|
|
1749 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1750 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1751
|
|
1752 -- Otherwise, allocate new shared string and fill it
|
|
1753
|
|
1754 else
|
|
1755 DR := Allocate (SR.Last);
|
|
1756
|
|
1757 for J in 1 .. SR.Last loop
|
|
1758 DR.Data (J) := Mapping.all (SR.Data (J));
|
|
1759 end loop;
|
|
1760
|
|
1761 DR.Last := SR.Last;
|
|
1762 end if;
|
|
1763
|
|
1764 return (AF.Controlled with Reference => DR);
|
|
1765
|
|
1766 exception
|
|
1767 when others =>
|
|
1768 Unreference (DR);
|
|
1769
|
|
1770 raise;
|
|
1771 end Translate;
|
|
1772
|
|
1773 procedure Translate
|
|
1774 (Source : in out Unbounded_Wide_Wide_String;
|
|
1775 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
|
|
1776 is
|
|
1777 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1778 DR : Shared_Wide_Wide_String_Access;
|
|
1779
|
|
1780 begin
|
|
1781 -- Nothing to translate
|
|
1782
|
|
1783 if SR.Last = 0 then
|
|
1784 null;
|
|
1785
|
|
1786 -- Try to reuse shared string
|
|
1787
|
|
1788 elsif Can_Be_Reused (SR, SR.Last) then
|
|
1789 for J in 1 .. SR.Last loop
|
|
1790 SR.Data (J) := Mapping.all (SR.Data (J));
|
|
1791 end loop;
|
|
1792
|
|
1793 -- Otherwise allocate new shared string and fill it
|
|
1794
|
|
1795 else
|
|
1796 DR := Allocate (SR.Last);
|
|
1797
|
|
1798 for J in 1 .. SR.Last loop
|
|
1799 DR.Data (J) := Mapping.all (SR.Data (J));
|
|
1800 end loop;
|
|
1801
|
|
1802 DR.Last := SR.Last;
|
|
1803 Source.Reference := DR;
|
|
1804 Unreference (SR);
|
|
1805 end if;
|
|
1806
|
|
1807 exception
|
|
1808 when others =>
|
|
1809 if DR /= null then
|
|
1810 Unreference (DR);
|
|
1811 end if;
|
|
1812
|
|
1813 raise;
|
|
1814 end Translate;
|
|
1815
|
|
1816 ----------
|
|
1817 -- Trim --
|
|
1818 ----------
|
|
1819
|
|
1820 function Trim
|
|
1821 (Source : Unbounded_Wide_Wide_String;
|
|
1822 Side : Trim_End) return Unbounded_Wide_Wide_String
|
|
1823 is
|
|
1824 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1825 DL : Natural;
|
|
1826 DR : Shared_Wide_Wide_String_Access;
|
|
1827 Low : Natural;
|
|
1828 High : Natural;
|
|
1829
|
|
1830 begin
|
|
1831 Low := Index_Non_Blank (Source, Forward);
|
|
1832
|
|
1833 -- All blanks, reuse empty shared string
|
|
1834
|
|
1835 if Low = 0 then
|
|
1836 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1837 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1838
|
|
1839 else
|
|
1840 case Side is
|
|
1841 when Left =>
|
|
1842 High := SR.Last;
|
|
1843 DL := SR.Last - Low + 1;
|
|
1844
|
|
1845 when Right =>
|
|
1846 Low := 1;
|
|
1847 High := Index_Non_Blank (Source, Backward);
|
|
1848 DL := High;
|
|
1849
|
|
1850 when Both =>
|
|
1851 High := Index_Non_Blank (Source, Backward);
|
|
1852 DL := High - Low + 1;
|
|
1853 end case;
|
|
1854
|
|
1855 -- Length of the result is the same as length of the source string,
|
|
1856 -- reuse source shared string.
|
|
1857
|
|
1858 if DL = SR.Last then
|
|
1859 Reference (SR);
|
|
1860 DR := SR;
|
|
1861
|
|
1862 -- Otherwise, allocate new shared string
|
|
1863
|
|
1864 else
|
|
1865 DR := Allocate (DL);
|
|
1866 DR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
1867 DR.Last := DL;
|
|
1868 end if;
|
|
1869 end if;
|
|
1870
|
|
1871 return (AF.Controlled with Reference => DR);
|
|
1872 end Trim;
|
|
1873
|
|
1874 procedure Trim
|
|
1875 (Source : in out Unbounded_Wide_Wide_String;
|
|
1876 Side : Trim_End)
|
|
1877 is
|
|
1878 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1879 DL : Natural;
|
|
1880 DR : Shared_Wide_Wide_String_Access;
|
|
1881 Low : Natural;
|
|
1882 High : Natural;
|
|
1883
|
|
1884 begin
|
|
1885 Low := Index_Non_Blank (Source, Forward);
|
|
1886
|
|
1887 -- All blanks, reuse empty shared string
|
|
1888
|
|
1889 if Low = 0 then
|
|
1890 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1891 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1892 Unreference (SR);
|
|
1893
|
|
1894 else
|
|
1895 case Side is
|
|
1896 when Left =>
|
|
1897 High := SR.Last;
|
|
1898 DL := SR.Last - Low + 1;
|
|
1899
|
|
1900 when Right =>
|
|
1901 Low := 1;
|
|
1902 High := Index_Non_Blank (Source, Backward);
|
|
1903 DL := High;
|
|
1904
|
|
1905 when Both =>
|
|
1906 High := Index_Non_Blank (Source, Backward);
|
|
1907 DL := High - Low + 1;
|
|
1908 end case;
|
|
1909
|
|
1910 -- Length of the result is the same as length of the source string,
|
|
1911 -- nothing to do.
|
|
1912
|
|
1913 if DL = SR.Last then
|
|
1914 null;
|
|
1915
|
|
1916 -- Try to reuse existent shared string
|
|
1917
|
|
1918 elsif Can_Be_Reused (SR, DL) then
|
|
1919 SR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
1920 SR.Last := DL;
|
|
1921
|
|
1922 -- Otherwise, allocate new shared string
|
|
1923
|
|
1924 else
|
|
1925 DR := Allocate (DL);
|
|
1926 DR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
1927 DR.Last := DL;
|
|
1928 Source.Reference := DR;
|
|
1929 Unreference (SR);
|
|
1930 end if;
|
|
1931 end if;
|
|
1932 end Trim;
|
|
1933
|
|
1934 function Trim
|
|
1935 (Source : Unbounded_Wide_Wide_String;
|
|
1936 Left : Wide_Wide_Maps.Wide_Wide_Character_Set;
|
|
1937 Right : Wide_Wide_Maps.Wide_Wide_Character_Set)
|
|
1938 return Unbounded_Wide_Wide_String
|
|
1939 is
|
|
1940 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1941 DL : Natural;
|
|
1942 DR : Shared_Wide_Wide_String_Access;
|
|
1943 Low : Natural;
|
|
1944 High : Natural;
|
|
1945
|
|
1946 begin
|
|
1947 Low := Index (Source, Left, Outside, Forward);
|
|
1948
|
|
1949 -- Source includes only characters from Left set, reuse empty shared
|
|
1950 -- string.
|
|
1951
|
|
1952 if Low = 0 then
|
|
1953 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1954 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1955
|
|
1956 else
|
|
1957 High := Index (Source, Right, Outside, Backward);
|
|
1958 DL := Integer'Max (0, High - Low + 1);
|
|
1959
|
|
1960 -- Source includes only characters from Right set or result string
|
|
1961 -- is empty, reuse empty shared string.
|
|
1962
|
|
1963 if High = 0 or else DL = 0 then
|
|
1964 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1965 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
1966
|
|
1967 -- Otherwise, allocate new shared string and fill it
|
|
1968
|
|
1969 else
|
|
1970 DR := Allocate (DL);
|
|
1971 DR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
1972 DR.Last := DL;
|
|
1973 end if;
|
|
1974 end if;
|
|
1975
|
|
1976 return (AF.Controlled with Reference => DR);
|
|
1977 end Trim;
|
|
1978
|
|
1979 procedure Trim
|
|
1980 (Source : in out Unbounded_Wide_Wide_String;
|
|
1981 Left : Wide_Wide_Maps.Wide_Wide_Character_Set;
|
|
1982 Right : Wide_Wide_Maps.Wide_Wide_Character_Set)
|
|
1983 is
|
|
1984 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
1985 DL : Natural;
|
|
1986 DR : Shared_Wide_Wide_String_Access;
|
|
1987 Low : Natural;
|
|
1988 High : Natural;
|
|
1989
|
|
1990 begin
|
|
1991 Low := Index (Source, Left, Outside, Forward);
|
|
1992
|
|
1993 -- Source includes only characters from Left set, reuse empty shared
|
|
1994 -- string.
|
|
1995
|
|
1996 if Low = 0 then
|
|
1997 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
1998 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
1999 Unreference (SR);
|
|
2000
|
|
2001 else
|
|
2002 High := Index (Source, Right, Outside, Backward);
|
|
2003 DL := Integer'Max (0, High - Low + 1);
|
|
2004
|
|
2005 -- Source includes only characters from Right set or result string
|
|
2006 -- is empty, reuse empty shared string.
|
|
2007
|
|
2008 if High = 0 or else DL = 0 then
|
|
2009 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
2010 Source.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
2011 Unreference (SR);
|
|
2012
|
|
2013 -- Try to reuse existent shared string
|
|
2014
|
|
2015 elsif Can_Be_Reused (SR, DL) then
|
|
2016 SR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
2017 SR.Last := DL;
|
|
2018
|
|
2019 -- Otherwise, allocate new shared string and fill it
|
|
2020
|
|
2021 else
|
|
2022 DR := Allocate (DL);
|
|
2023 DR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
2024 DR.Last := DL;
|
|
2025 Source.Reference := DR;
|
|
2026 Unreference (SR);
|
|
2027 end if;
|
|
2028 end if;
|
|
2029 end Trim;
|
|
2030
|
|
2031 ---------------------
|
|
2032 -- Unbounded_Slice --
|
|
2033 ---------------------
|
|
2034
|
|
2035 function Unbounded_Slice
|
|
2036 (Source : Unbounded_Wide_Wide_String;
|
|
2037 Low : Positive;
|
|
2038 High : Natural) return Unbounded_Wide_Wide_String
|
|
2039 is
|
|
2040 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
2041 DL : Natural;
|
|
2042 DR : Shared_Wide_Wide_String_Access;
|
|
2043
|
|
2044 begin
|
|
2045 -- Check bounds
|
|
2046
|
|
2047 if Low > SR.Last + 1 or else High > SR.Last then
|
|
2048 raise Index_Error;
|
|
2049
|
|
2050 -- Result is empty slice, reuse empty shared string
|
|
2051
|
|
2052 elsif Low > High then
|
|
2053 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
2054 DR := Empty_Shared_Wide_Wide_String'Access;
|
|
2055
|
|
2056 -- Otherwise, allocate new shared string and fill it
|
|
2057
|
|
2058 else
|
|
2059 DL := High - Low + 1;
|
|
2060 DR := Allocate (DL);
|
|
2061 DR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
2062 DR.Last := DL;
|
|
2063 end if;
|
|
2064
|
|
2065 return (AF.Controlled with Reference => DR);
|
|
2066 end Unbounded_Slice;
|
|
2067
|
|
2068 procedure Unbounded_Slice
|
|
2069 (Source : Unbounded_Wide_Wide_String;
|
|
2070 Target : out Unbounded_Wide_Wide_String;
|
|
2071 Low : Positive;
|
|
2072 High : Natural)
|
|
2073 is
|
|
2074 SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
|
|
2075 TR : constant Shared_Wide_Wide_String_Access := Target.Reference;
|
|
2076 DL : Natural;
|
|
2077 DR : Shared_Wide_Wide_String_Access;
|
|
2078
|
|
2079 begin
|
|
2080 -- Check bounds
|
|
2081
|
|
2082 if Low > SR.Last + 1 or else High > SR.Last then
|
|
2083 raise Index_Error;
|
|
2084
|
|
2085 -- Result is empty slice, reuse empty shared string
|
|
2086
|
|
2087 elsif Low > High then
|
|
2088 Reference (Empty_Shared_Wide_Wide_String'Access);
|
|
2089 Target.Reference := Empty_Shared_Wide_Wide_String'Access;
|
|
2090 Unreference (TR);
|
|
2091
|
|
2092 else
|
|
2093 DL := High - Low + 1;
|
|
2094
|
|
2095 -- Try to reuse existent shared string
|
|
2096
|
|
2097 if Can_Be_Reused (TR, DL) then
|
|
2098 TR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
2099 TR.Last := DL;
|
|
2100
|
|
2101 -- Otherwise, allocate new shared string and fill it
|
|
2102
|
|
2103 else
|
|
2104 DR := Allocate (DL);
|
|
2105 DR.Data (1 .. DL) := SR.Data (Low .. High);
|
|
2106 DR.Last := DL;
|
|
2107 Target.Reference := DR;
|
|
2108 Unreference (TR);
|
|
2109 end if;
|
|
2110 end if;
|
|
2111 end Unbounded_Slice;
|
|
2112
|
|
2113 -----------------
|
|
2114 -- Unreference --
|
|
2115 -----------------
|
|
2116
|
|
2117 procedure Unreference (Item : not null Shared_Wide_Wide_String_Access) is
|
|
2118
|
|
2119 procedure Free is
|
|
2120 new Ada.Unchecked_Deallocation
|
|
2121 (Shared_Wide_Wide_String, Shared_Wide_Wide_String_Access);
|
|
2122
|
|
2123 Aux : Shared_Wide_Wide_String_Access := Item;
|
|
2124
|
|
2125 begin
|
|
2126 if System.Atomic_Counters.Decrement (Aux.Counter) then
|
|
2127
|
|
2128 -- Reference counter of Empty_Shared_Wide_Wide_String must never
|
|
2129 -- reach zero.
|
|
2130
|
|
2131 pragma Assert (Aux /= Empty_Shared_Wide_Wide_String'Access);
|
|
2132
|
|
2133 Free (Aux);
|
|
2134 end if;
|
|
2135 end Unreference;
|
|
2136
|
|
2137 end Ada.Strings.Wide_Wide_Unbounded;
|