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