Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-stwiun.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . W I D E _ U N B O U N D E D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2017, 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_Fixed;
33 with Ada.Strings.Wide_Search;
34 with Ada.Unchecked_Deallocation;
35
36 package body Ada.Strings.Wide_Unbounded is
37
38 ---------
39 -- "&" --
40 ---------
41
42 function "&"
43 (Left : Unbounded_Wide_String;
44 Right : Unbounded_Wide_String) return Unbounded_Wide_String
45 is
46 L_Length : constant Natural := Left.Last;
47 R_Length : constant Natural := Right.Last;
48 Result : Unbounded_Wide_String;
49
50 begin
51 Result.Last := L_Length + R_Length;
52
53 Result.Reference := new 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_String;
65 Right : Wide_String) return Unbounded_Wide_String
66 is
67 L_Length : constant Natural := Left.Last;
68 Result : Unbounded_Wide_String;
69
70 begin
71 Result.Last := L_Length + Right'Length;
72
73 Result.Reference := new 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_String;
83 Right : Unbounded_Wide_String) return Unbounded_Wide_String
84 is
85 R_Length : constant Natural := Right.Last;
86 Result : Unbounded_Wide_String;
87
88 begin
89 Result.Last := Left'Length + R_Length;
90
91 Result.Reference := new 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_String;
102 Right : Wide_Character) return Unbounded_Wide_String
103 is
104 Result : Unbounded_Wide_String;
105
106 begin
107 Result.Last := Left.Last + 1;
108
109 Result.Reference := new 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_Character;
120 Right : Unbounded_Wide_String) return Unbounded_Wide_String
121 is
122 Result : Unbounded_Wide_String;
123
124 begin
125 Result.Last := Right.Last + 1;
126
127 Result.Reference := new 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_Character) return Unbounded_Wide_String
141 is
142 Result : Unbounded_Wide_String;
143
144 begin
145 Result.Last := Left;
146
147 Result.Reference := new 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_String) return Unbounded_Wide_String
158 is
159 Len : constant Natural := Right'Length;
160 K : Positive;
161 Result : Unbounded_Wide_String;
162
163 begin
164 Result.Last := Left * Len;
165
166 Result.Reference := new 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_String) return Unbounded_Wide_String
180 is
181 Len : constant Natural := Right.Last;
182 K : Positive;
183 Result : Unbounded_Wide_String;
184
185 begin
186 Result.Last := Left * Len;
187
188 Result.Reference := new 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_String;
206 Right : Unbounded_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_String;
215 Right : Wide_String) return Boolean
216 is
217 begin
218 return Left.Reference (1 .. Left.Last) < Right;
219 end "<";
220
221 function "<"
222 (Left : Wide_String;
223 Right : Unbounded_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_String;
235 Right : Unbounded_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_String;
244 Right : Wide_String) return Boolean
245 is
246 begin
247 return Left.Reference (1 .. Left.Last) <= Right;
248 end "<=";
249
250 function "<="
251 (Left : Wide_String;
252 Right : Unbounded_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_String;
264 Right : Unbounded_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_String;
273 Right : Wide_String) return Boolean
274 is
275 begin
276 return Left.Reference (1 .. Left.Last) = Right;
277 end "=";
278
279 function "="
280 (Left : Wide_String;
281 Right : Unbounded_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_String;
293 Right : Unbounded_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_String;
302 Right : Wide_String) return Boolean
303 is
304 begin
305 return Left.Reference (1 .. Left.Last) > Right;
306 end ">";
307
308 function ">"
309 (Left : Wide_String;
310 Right : Unbounded_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_String;
322 Right : Unbounded_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_String;
331 Right : Wide_String) return Boolean
332 is
333 begin
334 return Left.Reference (1 .. Left.Last) >= Right;
335 end ">=";
336
337 function ">="
338 (Left : Wide_String;
339 Right : Unbounded_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_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_String'Access then
356 Object.Reference :=
357 new 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_String;
367 New_Item : Unbounded_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_String;
378 New_Item : 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_String;
389 New_Item : 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_String;
403 Pattern : Wide_String;
404 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
405 return Natural
406 is
407 begin
408 return
409 Wide_Search.Count
410 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
411 end Count;
412
413 function Count
414 (Source : Unbounded_Wide_String;
415 Pattern : Wide_String;
416 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
417 is
418 begin
419 return
420 Wide_Search.Count
421 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
422 end Count;
423
424 function Count
425 (Source : Unbounded_Wide_String;
426 Set : Wide_Maps.Wide_Character_Set) return Natural
427 is
428 begin
429 return
430 Wide_Search.Count
431 (Source.Reference (1 .. Source.Last), Set);
432 end Count;
433
434 ------------
435 -- Delete --
436 ------------
437
438 function Delete
439 (Source : Unbounded_Wide_String;
440 From : Positive;
441 Through : Natural) return Unbounded_Wide_String
442 is
443 begin
444 return
445 To_Unbounded_Wide_String
446 (Wide_Fixed.Delete
447 (Source.Reference (1 .. Source.Last), From, Through));
448 end Delete;
449
450 procedure Delete
451 (Source : in out Unbounded_Wide_String;
452 From : Positive;
453 Through : Natural)
454 is
455 begin
456 if From > Through then
457 null;
458
459 elsif From < Source.Reference'First or else Through > Source.Last then
460 raise Index_Error;
461
462 else
463 declare
464 Len : constant Natural := Through - From + 1;
465
466 begin
467 Source.Reference (From .. Source.Last - Len) :=
468 Source.Reference (Through + 1 .. Source.Last);
469 Source.Last := Source.Last - Len;
470 end;
471 end if;
472 end Delete;
473
474 -------------
475 -- Element --
476 -------------
477
478 function Element
479 (Source : Unbounded_Wide_String;
480 Index : Positive) return Wide_Character
481 is
482 begin
483 if Index <= Source.Last then
484 return Source.Reference (Index);
485 else
486 raise Strings.Index_Error;
487 end if;
488 end Element;
489
490 --------------
491 -- Finalize --
492 --------------
493
494 procedure Finalize (Object : in out Unbounded_Wide_String) is
495 procedure Deallocate is
496 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
497
498 begin
499 -- Note: Don't try to free statically allocated null string
500
501 if Object.Reference /= Null_Wide_String'Access then
502 Deallocate (Object.Reference);
503 Object.Reference := Null_Unbounded_Wide_String.Reference;
504 Object.Last := 0;
505 end if;
506 end Finalize;
507
508 ----------------
509 -- Find_Token --
510 ----------------
511
512 procedure Find_Token
513 (Source : Unbounded_Wide_String;
514 Set : Wide_Maps.Wide_Character_Set;
515 From : Positive;
516 Test : Strings.Membership;
517 First : out Positive;
518 Last : out Natural)
519 is
520 begin
521 Wide_Search.Find_Token
522 (Source.Reference (From .. Source.Last), Set, Test, First, Last);
523 end Find_Token;
524
525 procedure Find_Token
526 (Source : Unbounded_Wide_String;
527 Set : Wide_Maps.Wide_Character_Set;
528 Test : Strings.Membership;
529 First : out Positive;
530 Last : out Natural)
531 is
532 begin
533 Wide_Search.Find_Token
534 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
535 end Find_Token;
536
537 ----------
538 -- Free --
539 ----------
540
541 procedure Free (X : in out Wide_String_Access) is
542 procedure Deallocate is
543 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
544
545 begin
546 -- Note: Do not try to free statically allocated null string
547
548 if X /= Null_Unbounded_Wide_String.Reference then
549 Deallocate (X);
550 end if;
551 end Free;
552
553 ----------
554 -- Head --
555 ----------
556
557 function Head
558 (Source : Unbounded_Wide_String;
559 Count : Natural;
560 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
561 is
562 begin
563 return To_Unbounded_Wide_String
564 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
565 end Head;
566
567 procedure Head
568 (Source : in out Unbounded_Wide_String;
569 Count : Natural;
570 Pad : Wide_Character := Wide_Space)
571 is
572 Old : Wide_String_Access := Source.Reference;
573 begin
574 Source.Reference :=
575 new Wide_String'
576 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
577 Source.Last := Source.Reference'Length;
578 Free (Old);
579 end Head;
580
581 -----------
582 -- Index --
583 -----------
584
585 function Index
586 (Source : Unbounded_Wide_String;
587 Pattern : Wide_String;
588 Going : Strings.Direction := Strings.Forward;
589 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
590 return Natural
591 is
592 begin
593 return
594 Wide_Search.Index
595 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
596 end Index;
597
598 function Index
599 (Source : Unbounded_Wide_String;
600 Pattern : Wide_String;
601 Going : Direction := Forward;
602 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
603 is
604 begin
605 return
606 Wide_Search.Index
607 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
608 end Index;
609
610 function Index
611 (Source : Unbounded_Wide_String;
612 Set : Wide_Maps.Wide_Character_Set;
613 Test : Strings.Membership := Strings.Inside;
614 Going : Strings.Direction := Strings.Forward) return Natural
615 is
616 begin
617 return Wide_Search.Index
618 (Source.Reference (1 .. Source.Last), Set, Test, Going);
619 end Index;
620
621 function Index
622 (Source : Unbounded_Wide_String;
623 Pattern : Wide_String;
624 From : Positive;
625 Going : Direction := Forward;
626 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
627 return Natural
628 is
629 begin
630 return
631 Wide_Search.Index
632 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
633 end Index;
634
635 function Index
636 (Source : Unbounded_Wide_String;
637 Pattern : Wide_String;
638 From : Positive;
639 Going : Direction := Forward;
640 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
641 is
642 begin
643 return
644 Wide_Search.Index
645 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
646 end Index;
647
648 function Index
649 (Source : Unbounded_Wide_String;
650 Set : Wide_Maps.Wide_Character_Set;
651 From : Positive;
652 Test : Membership := Inside;
653 Going : Direction := Forward) return Natural
654 is
655 begin
656 return
657 Wide_Search.Index
658 (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
659 end Index;
660
661 function Index_Non_Blank
662 (Source : Unbounded_Wide_String;
663 Going : Strings.Direction := Strings.Forward) return Natural
664 is
665 begin
666 return
667 Wide_Search.Index_Non_Blank
668 (Source.Reference (1 .. Source.Last), Going);
669 end Index_Non_Blank;
670
671 function Index_Non_Blank
672 (Source : Unbounded_Wide_String;
673 From : Positive;
674 Going : Direction := Forward) return Natural
675 is
676 begin
677 return
678 Wide_Search.Index_Non_Blank
679 (Source.Reference (1 .. Source.Last), From, Going);
680 end Index_Non_Blank;
681
682 ----------------
683 -- Initialize --
684 ----------------
685
686 procedure Initialize (Object : in out Unbounded_Wide_String) is
687 begin
688 Object.Reference := Null_Unbounded_Wide_String.Reference;
689 Object.Last := 0;
690 end Initialize;
691
692 ------------
693 -- Insert --
694 ------------
695
696 function Insert
697 (Source : Unbounded_Wide_String;
698 Before : Positive;
699 New_Item : Wide_String) return Unbounded_Wide_String
700 is
701 begin
702 return
703 To_Unbounded_Wide_String
704 (Wide_Fixed.Insert
705 (Source.Reference (1 .. Source.Last), Before, New_Item));
706 end Insert;
707
708 procedure Insert
709 (Source : in out Unbounded_Wide_String;
710 Before : Positive;
711 New_Item : Wide_String)
712 is
713 begin
714 if Before not in Source.Reference'First .. Source.Last + 1 then
715 raise Index_Error;
716 end if;
717
718 Realloc_For_Chunk (Source, New_Item'Length);
719
720 Source.Reference
721 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
722 Source.Reference (Before .. Source.Last);
723
724 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
725 Source.Last := Source.Last + New_Item'Length;
726 end Insert;
727
728 ------------
729 -- Length --
730 ------------
731
732 function Length (Source : Unbounded_Wide_String) return Natural is
733 begin
734 return Source.Last;
735 end Length;
736
737 ---------------
738 -- Overwrite --
739 ---------------
740
741 function Overwrite
742 (Source : Unbounded_Wide_String;
743 Position : Positive;
744 New_Item : Wide_String) return Unbounded_Wide_String
745 is
746 begin
747 return
748 To_Unbounded_Wide_String
749 (Wide_Fixed.Overwrite
750 (Source.Reference (1 .. Source.Last), Position, New_Item));
751 end Overwrite;
752
753 procedure Overwrite
754 (Source : in out Unbounded_Wide_String;
755 Position : Positive;
756 New_Item : Wide_String)
757 is
758 NL : constant Natural := New_Item'Length;
759 begin
760 if Position <= Source.Last - NL + 1 then
761 Source.Reference (Position .. Position + NL - 1) := New_Item;
762 else
763 declare
764 Old : Wide_String_Access := Source.Reference;
765 begin
766 Source.Reference := new Wide_String'
767 (Wide_Fixed.Overwrite
768 (Source.Reference (1 .. Source.Last), Position, New_Item));
769 Source.Last := Source.Reference'Length;
770 Free (Old);
771 end;
772 end if;
773 end Overwrite;
774
775 -----------------------
776 -- Realloc_For_Chunk --
777 -----------------------
778
779 procedure Realloc_For_Chunk
780 (Source : in out Unbounded_Wide_String;
781 Chunk_Size : Natural)
782 is
783 Growth_Factor : constant := 32;
784 -- The growth factor controls how much extra space is allocated when
785 -- we have to increase the size of an allocated unbounded string. By
786 -- allocating extra space, we avoid the need to reallocate on every
787 -- append, particularly important when a string is built up by repeated
788 -- append operations of small pieces. This is expressed as a factor so
789 -- 32 means add 1/32 of the length of the string as growth space.
790
791 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
792 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
793 -- no memory loss as most (all?) malloc implementations are obliged to
794 -- align the returned memory on the maximum alignment as malloc does not
795 -- know the target alignment.
796
797 S_Length : constant Natural := Source.Reference'Length;
798
799 begin
800 if Chunk_Size > S_Length - Source.Last then
801 declare
802 New_Size : constant Positive :=
803 S_Length + Chunk_Size + (S_Length / Growth_Factor);
804
805 New_Rounded_Up_Size : constant Positive :=
806 ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
807
808 Tmp : constant Wide_String_Access :=
809 new Wide_String (1 .. New_Rounded_Up_Size);
810
811 begin
812 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
813 Free (Source.Reference);
814 Source.Reference := Tmp;
815 end;
816 end if;
817 end Realloc_For_Chunk;
818
819 ---------------------
820 -- Replace_Element --
821 ---------------------
822
823 procedure Replace_Element
824 (Source : in out Unbounded_Wide_String;
825 Index : Positive;
826 By : Wide_Character)
827 is
828 begin
829 if Index <= Source.Last then
830 Source.Reference (Index) := By;
831 else
832 raise Strings.Index_Error;
833 end if;
834 end Replace_Element;
835
836 -------------------
837 -- Replace_Slice --
838 -------------------
839
840 function Replace_Slice
841 (Source : Unbounded_Wide_String;
842 Low : Positive;
843 High : Natural;
844 By : Wide_String) return Unbounded_Wide_String
845 is
846 begin
847 return To_Unbounded_Wide_String
848 (Wide_Fixed.Replace_Slice
849 (Source.Reference (1 .. Source.Last), Low, High, By));
850 end Replace_Slice;
851
852 procedure Replace_Slice
853 (Source : in out Unbounded_Wide_String;
854 Low : Positive;
855 High : Natural;
856 By : Wide_String)
857 is
858 Old : Wide_String_Access := Source.Reference;
859 begin
860 Source.Reference := new Wide_String'
861 (Wide_Fixed.Replace_Slice
862 (Source.Reference (1 .. Source.Last), Low, High, By));
863 Source.Last := Source.Reference'Length;
864 Free (Old);
865 end Replace_Slice;
866
867 -------------------------------
868 -- Set_Unbounded_Wide_String --
869 -------------------------------
870
871 procedure Set_Unbounded_Wide_String
872 (Target : out Unbounded_Wide_String;
873 Source : Wide_String)
874 is
875 begin
876 Target.Last := Source'Length;
877 Target.Reference := new Wide_String (1 .. Source'Length);
878 Target.Reference.all := Source;
879 end Set_Unbounded_Wide_String;
880
881 -----------
882 -- Slice --
883 -----------
884
885 function Slice
886 (Source : Unbounded_Wide_String;
887 Low : Positive;
888 High : Natural) return Wide_String
889 is
890 begin
891 -- Note: test of High > Length is in accordance with AI95-00128
892
893 if Low > Source.Last + 1 or else High > Source.Last then
894 raise Index_Error;
895 else
896 return Source.Reference (Low .. High);
897 end if;
898 end Slice;
899
900 ----------
901 -- Tail --
902 ----------
903
904 function Tail
905 (Source : Unbounded_Wide_String;
906 Count : Natural;
907 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is
908 begin
909 return To_Unbounded_Wide_String
910 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
911 end Tail;
912
913 procedure Tail
914 (Source : in out Unbounded_Wide_String;
915 Count : Natural;
916 Pad : Wide_Character := Wide_Space)
917 is
918 Old : Wide_String_Access := Source.Reference;
919 begin
920 Source.Reference := new Wide_String'
921 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
922 Source.Last := Source.Reference'Length;
923 Free (Old);
924 end Tail;
925
926 ------------------------------
927 -- To_Unbounded_Wide_String --
928 ------------------------------
929
930 function To_Unbounded_Wide_String
931 (Source : Wide_String)
932 return Unbounded_Wide_String
933 is
934 Result : Unbounded_Wide_String;
935 begin
936 Result.Last := Source'Length;
937 Result.Reference := new Wide_String (1 .. Source'Length);
938 Result.Reference.all := Source;
939 return Result;
940 end To_Unbounded_Wide_String;
941
942 function To_Unbounded_Wide_String
943 (Length : Natural) return Unbounded_Wide_String
944 is
945 Result : Unbounded_Wide_String;
946 begin
947 Result.Last := Length;
948 Result.Reference := new Wide_String (1 .. Length);
949 return Result;
950 end To_Unbounded_Wide_String;
951
952 -------------------
953 -- To_Wide_String --
954 --------------------
955
956 function To_Wide_String
957 (Source : Unbounded_Wide_String)
958 return Wide_String
959 is
960 begin
961 return Source.Reference (1 .. Source.Last);
962 end To_Wide_String;
963
964 ---------------
965 -- Translate --
966 ---------------
967
968 function Translate
969 (Source : Unbounded_Wide_String;
970 Mapping : Wide_Maps.Wide_Character_Mapping)
971 return Unbounded_Wide_String
972 is
973 begin
974 return
975 To_Unbounded_Wide_String
976 (Wide_Fixed.Translate
977 (Source.Reference (1 .. Source.Last), Mapping));
978 end Translate;
979
980 procedure Translate
981 (Source : in out Unbounded_Wide_String;
982 Mapping : Wide_Maps.Wide_Character_Mapping)
983 is
984 begin
985 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
986 end Translate;
987
988 function Translate
989 (Source : Unbounded_Wide_String;
990 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
991 return Unbounded_Wide_String
992 is
993 begin
994 return
995 To_Unbounded_Wide_String
996 (Wide_Fixed.Translate
997 (Source.Reference (1 .. Source.Last), Mapping));
998 end Translate;
999
1000 procedure Translate
1001 (Source : in out Unbounded_Wide_String;
1002 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
1003 is
1004 begin
1005 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1006 end Translate;
1007
1008 ----------
1009 -- Trim --
1010 ----------
1011
1012 function Trim
1013 (Source : Unbounded_Wide_String;
1014 Side : Trim_End) return Unbounded_Wide_String
1015 is
1016 begin
1017 return
1018 To_Unbounded_Wide_String
1019 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1020 end Trim;
1021
1022 procedure Trim
1023 (Source : in out Unbounded_Wide_String;
1024 Side : Trim_End)
1025 is
1026 Old : Wide_String_Access := Source.Reference;
1027 begin
1028 Source.Reference :=
1029 new Wide_String'
1030 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1031 Source.Last := Source.Reference'Length;
1032 Free (Old);
1033 end Trim;
1034
1035 function Trim
1036 (Source : Unbounded_Wide_String;
1037 Left : Wide_Maps.Wide_Character_Set;
1038 Right : Wide_Maps.Wide_Character_Set)
1039 return Unbounded_Wide_String
1040 is
1041 begin
1042 return
1043 To_Unbounded_Wide_String
1044 (Wide_Fixed.Trim
1045 (Source.Reference (1 .. Source.Last), Left, Right));
1046 end Trim;
1047
1048 procedure Trim
1049 (Source : in out Unbounded_Wide_String;
1050 Left : Wide_Maps.Wide_Character_Set;
1051 Right : Wide_Maps.Wide_Character_Set)
1052 is
1053 Old : Wide_String_Access := Source.Reference;
1054 begin
1055 Source.Reference :=
1056 new Wide_String'
1057 (Wide_Fixed.Trim
1058 (Source.Reference (1 .. Source.Last), Left, Right));
1059 Source.Last := Source.Reference'Length;
1060 Free (Old);
1061 end Trim;
1062
1063 ---------------------
1064 -- Unbounded_Slice --
1065 ---------------------
1066
1067 function Unbounded_Slice
1068 (Source : Unbounded_Wide_String;
1069 Low : Positive;
1070 High : Natural) return Unbounded_Wide_String
1071 is
1072 begin
1073 if Low > Source.Last + 1 or else High > Source.Last then
1074 raise Index_Error;
1075 else
1076 return To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1077 end if;
1078 end Unbounded_Slice;
1079
1080 procedure Unbounded_Slice
1081 (Source : Unbounded_Wide_String;
1082 Target : out Unbounded_Wide_String;
1083 Low : Positive;
1084 High : Natural)
1085 is
1086 begin
1087 if Low > Source.Last + 1 or else High > Source.Last then
1088 raise Index_Error;
1089 else
1090 Target :=
1091 To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1092 end if;
1093 end Unbounded_Slice;
1094
1095 end Ada.Strings.Wide_Unbounded;