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