* config/mips/mips.c (function_arg): Where one part of a
[official-gcc.git] / gcc / ada / a-stzunb.adb
blob7f4c54a94c34b1b1bc920c5821e1ca63008e21ed
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-2005, 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 -- --
32 ------------------------------------------------------------------------------
34 with Ada.Strings.Wide_Wide_Fixed;
35 with Ada.Strings.Wide_Wide_Search;
36 with Ada.Unchecked_Deallocation;
38 package body Ada.Strings.Wide_Wide_Unbounded is
40 use Ada.Finalization;
42 ---------
43 -- "&" --
44 ---------
46 function "&"
47 (Left : Unbounded_Wide_Wide_String;
48 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
50 L_Length : constant Natural := Left.Last;
51 R_Length : constant Natural := Right.Last;
52 Result : Unbounded_Wide_Wide_String;
54 begin
55 Result.Last := L_Length + R_Length;
57 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
59 Result.Reference (1 .. L_Length) :=
60 Left.Reference (1 .. Left.Last);
61 Result.Reference (L_Length + 1 .. Result.Last) :=
62 Right.Reference (1 .. Right.Last);
64 return Result;
65 end "&";
67 function "&"
68 (Left : Unbounded_Wide_Wide_String;
69 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
71 L_Length : constant Natural := Left.Last;
72 Result : Unbounded_Wide_Wide_String;
74 begin
75 Result.Last := L_Length + Right'Length;
77 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
79 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
80 Result.Reference (L_Length + 1 .. Result.Last) := Right;
82 return Result;
83 end "&";
85 function "&"
86 (Left : Wide_Wide_String;
87 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
89 R_Length : constant Natural := Right.Last;
90 Result : Unbounded_Wide_Wide_String;
92 begin
93 Result.Last := Left'Length + R_Length;
95 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
97 Result.Reference (1 .. Left'Length) := Left;
98 Result.Reference (Left'Length + 1 .. Result.Last) :=
99 Right.Reference (1 .. Right.Last);
101 return Result;
102 end "&";
104 function "&"
105 (Left : Unbounded_Wide_Wide_String;
106 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
108 Result : Unbounded_Wide_Wide_String;
110 begin
111 Result.Last := Left.Last + 1;
113 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
115 Result.Reference (1 .. Result.Last - 1) :=
116 Left.Reference (1 .. Left.Last);
117 Result.Reference (Result.Last) := Right;
119 return Result;
120 end "&";
122 function "&"
123 (Left : Wide_Wide_Character;
124 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
126 Result : Unbounded_Wide_Wide_String;
128 begin
129 Result.Last := Right.Last + 1;
131 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
132 Result.Reference (1) := Left;
133 Result.Reference (2 .. Result.Last) :=
134 Right.Reference (1 .. Right.Last);
135 return Result;
136 end "&";
138 ---------
139 -- "*" --
140 ---------
142 function "*"
143 (Left : Natural;
144 Right : Wide_Wide_Character) return Unbounded_Wide_Wide_String
146 Result : Unbounded_Wide_Wide_String;
148 begin
149 Result.Last := Left;
151 Result.Reference := new Wide_Wide_String (1 .. Left);
152 for J in Result.Reference'Range loop
153 Result.Reference (J) := Right;
154 end loop;
156 return Result;
157 end "*";
159 function "*"
160 (Left : Natural;
161 Right : Wide_Wide_String) return Unbounded_Wide_Wide_String
163 Len : constant Natural := Right'Length;
164 K : Positive;
165 Result : Unbounded_Wide_Wide_String;
167 begin
168 Result.Last := Left * Len;
170 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
172 K := 1;
173 for J in 1 .. Left loop
174 Result.Reference (K .. K + Len - 1) := Right;
175 K := K + Len;
176 end loop;
178 return Result;
179 end "*";
181 function "*"
182 (Left : Natural;
183 Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String
185 Len : constant Natural := Right.Last;
186 K : Positive;
187 Result : Unbounded_Wide_Wide_String;
189 begin
190 Result.Last := Left * Len;
192 Result.Reference := new Wide_Wide_String (1 .. Result.Last);
194 K := 1;
195 for J in 1 .. Left loop
196 Result.Reference (K .. K + Len - 1) :=
197 Right.Reference (1 .. Right.Last);
198 K := K + Len;
199 end loop;
201 return Result;
202 end "*";
204 ---------
205 -- "<" --
206 ---------
208 function "<"
209 (Left : Unbounded_Wide_Wide_String;
210 Right : Unbounded_Wide_Wide_String) return Boolean
212 begin
213 return
214 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
215 end "<";
217 function "<"
218 (Left : Unbounded_Wide_Wide_String;
219 Right : Wide_Wide_String) return Boolean
221 begin
222 return Left.Reference (1 .. Left.Last) < Right;
223 end "<";
225 function "<"
226 (Left : Wide_Wide_String;
227 Right : Unbounded_Wide_Wide_String) return Boolean
229 begin
230 return Left < Right.Reference (1 .. Right.Last);
231 end "<";
233 ----------
234 -- "<=" --
235 ----------
237 function "<="
238 (Left : Unbounded_Wide_Wide_String;
239 Right : Unbounded_Wide_Wide_String) return Boolean
241 begin
242 return
243 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
244 end "<=";
246 function "<="
247 (Left : Unbounded_Wide_Wide_String;
248 Right : Wide_Wide_String) return Boolean
250 begin
251 return Left.Reference (1 .. Left.Last) <= Right;
252 end "<=";
254 function "<="
255 (Left : Wide_Wide_String;
256 Right : Unbounded_Wide_Wide_String) return Boolean
258 begin
259 return Left <= Right.Reference (1 .. Right.Last);
260 end "<=";
262 ---------
263 -- "=" --
264 ---------
266 function "="
267 (Left : Unbounded_Wide_Wide_String;
268 Right : Unbounded_Wide_Wide_String) return Boolean
270 begin
271 return
272 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
273 end "=";
275 function "="
276 (Left : Unbounded_Wide_Wide_String;
277 Right : Wide_Wide_String) return Boolean
279 begin
280 return Left.Reference (1 .. Left.Last) = Right;
281 end "=";
283 function "="
284 (Left : Wide_Wide_String;
285 Right : Unbounded_Wide_Wide_String) return Boolean
287 begin
288 return Left = Right.Reference (1 .. Right.Last);
289 end "=";
291 ---------
292 -- ">" --
293 ---------
295 function ">"
296 (Left : Unbounded_Wide_Wide_String;
297 Right : Unbounded_Wide_Wide_String) return Boolean
299 begin
300 return
301 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
302 end ">";
304 function ">"
305 (Left : Unbounded_Wide_Wide_String;
306 Right : Wide_Wide_String) return Boolean
308 begin
309 return Left.Reference (1 .. Left.Last) > Right;
310 end ">";
312 function ">"
313 (Left : Wide_Wide_String;
314 Right : Unbounded_Wide_Wide_String) return Boolean
316 begin
317 return Left > Right.Reference (1 .. Right.Last);
318 end ">";
320 ----------
321 -- ">=" --
322 ----------
324 function ">="
325 (Left : Unbounded_Wide_Wide_String;
326 Right : Unbounded_Wide_Wide_String) return Boolean
328 begin
329 return
330 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
331 end ">=";
333 function ">="
334 (Left : Unbounded_Wide_Wide_String;
335 Right : Wide_Wide_String) return Boolean
337 begin
338 return Left.Reference (1 .. Left.Last) >= Right;
339 end ">=";
341 function ">="
342 (Left : Wide_Wide_String;
343 Right : Unbounded_Wide_Wide_String) return Boolean
345 begin
346 return Left >= Right.Reference (1 .. Right.Last);
347 end ">=";
349 ------------
350 -- Adjust --
351 ------------
353 procedure Adjust (Object : in out Unbounded_Wide_Wide_String) is
354 begin
355 -- Copy string, except we do not copy the statically allocated null
356 -- string, since it can never be deallocated. Note that we do not copy
357 -- extra string room here to avoid dragging unused allocated memory.
359 if Object.Reference /= Null_Wide_Wide_String'Access then
360 Object.Reference :=
361 new Wide_Wide_String'(Object.Reference (1 .. Object.Last));
362 end if;
363 end Adjust;
365 ------------
366 -- Append --
367 ------------
369 procedure Append
370 (Source : in out Unbounded_Wide_Wide_String;
371 New_Item : Unbounded_Wide_Wide_String)
373 begin
374 Realloc_For_Chunk (Source, New_Item.Last);
375 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
376 New_Item.Reference (1 .. New_Item.Last);
377 Source.Last := Source.Last + New_Item.Last;
378 end Append;
380 procedure Append
381 (Source : in out Unbounded_Wide_Wide_String;
382 New_Item : Wide_Wide_String)
384 begin
385 Realloc_For_Chunk (Source, New_Item'Length);
386 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
387 New_Item;
388 Source.Last := Source.Last + New_Item'Length;
389 end Append;
391 procedure Append
392 (Source : in out Unbounded_Wide_Wide_String;
393 New_Item : Wide_Wide_Character)
395 begin
396 Realloc_For_Chunk (Source, 1);
397 Source.Reference (Source.Last + 1) := New_Item;
398 Source.Last := Source.Last + 1;
399 end Append;
401 -----------
402 -- Count --
403 -----------
405 function Count
406 (Source : Unbounded_Wide_Wide_String;
407 Pattern : Wide_Wide_String;
408 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
409 Wide_Wide_Maps.Identity)
410 return Natural
412 begin
413 return
414 Wide_Wide_Search.Count
415 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
416 end Count;
418 function Count
419 (Source : Unbounded_Wide_Wide_String;
420 Pattern : Wide_Wide_String;
421 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
422 return Natural
424 begin
425 return
426 Wide_Wide_Search.Count
427 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
428 end Count;
430 function Count
431 (Source : Unbounded_Wide_Wide_String;
432 Set : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
434 begin
435 return
436 Wide_Wide_Search.Count
437 (Source.Reference (1 .. Source.Last), Set);
438 end Count;
440 ------------
441 -- Delete --
442 ------------
444 function Delete
445 (Source : Unbounded_Wide_Wide_String;
446 From : Positive;
447 Through : Natural) return Unbounded_Wide_Wide_String
449 begin
450 return
451 To_Unbounded_Wide_Wide_String
452 (Wide_Wide_Fixed.Delete
453 (Source.Reference (1 .. Source.Last), From, Through));
454 end Delete;
456 procedure Delete
457 (Source : in out Unbounded_Wide_Wide_String;
458 From : Positive;
459 Through : Natural)
461 begin
462 if From > Through then
463 null;
465 elsif From < Source.Reference'First or else Through > Source.Last then
466 raise Index_Error;
468 else
469 declare
470 Len : constant Natural := Through - From + 1;
472 begin
473 Source.Reference (From .. Source.Last - Len) :=
474 Source.Reference (Through + 1 .. Source.Last);
475 Source.Last := Source.Last - Len;
476 end;
477 end if;
478 end Delete;
480 -------------
481 -- Element --
482 -------------
484 function Element
485 (Source : Unbounded_Wide_Wide_String;
486 Index : Positive) return Wide_Wide_Character
488 begin
489 if Index <= Source.Last then
490 return Source.Reference (Index);
491 else
492 raise Strings.Index_Error;
493 end if;
494 end Element;
496 --------------
497 -- Finalize --
498 --------------
500 procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
501 procedure Deallocate is
502 new Ada.Unchecked_Deallocation
503 (Wide_Wide_String, Wide_Wide_String_Access);
505 begin
506 -- Note: Don't try to free statically allocated null string
508 if Object.Reference /= Null_Wide_Wide_String'Access then
509 Deallocate (Object.Reference);
510 Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
511 Object.Last := 0;
512 end if;
513 end Finalize;
515 ----------------
516 -- Find_Token --
517 ----------------
519 procedure Find_Token
520 (Source : Unbounded_Wide_Wide_String;
521 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
522 Test : Strings.Membership;
523 First : out Positive;
524 Last : out Natural)
526 begin
527 Wide_Wide_Search.Find_Token
528 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
529 end Find_Token;
531 ----------
532 -- Free --
533 ----------
535 procedure Free (X : in out Wide_Wide_String_Access) is
536 procedure Deallocate is
537 new Ada.Unchecked_Deallocation
538 (Wide_Wide_String, Wide_Wide_String_Access);
540 begin
541 -- Note: Do not try to free statically allocated null string
543 if X /= Null_Unbounded_Wide_Wide_String.Reference then
544 Deallocate (X);
545 end if;
546 end Free;
548 ----------
549 -- Head --
550 ----------
552 function Head
553 (Source : Unbounded_Wide_Wide_String;
554 Count : Natural;
555 Pad : Wide_Wide_Character := Wide_Wide_Space)
556 return Unbounded_Wide_Wide_String
558 begin
559 return To_Unbounded_Wide_Wide_String
560 (Wide_Wide_Fixed.Head
561 (Source.Reference (1 .. Source.Last), Count, Pad));
562 end Head;
564 procedure Head
565 (Source : in out Unbounded_Wide_Wide_String;
566 Count : Natural;
567 Pad : Wide_Wide_Character := Wide_Wide_Space)
569 Old : Wide_Wide_String_Access := Source.Reference;
570 begin
571 Source.Reference :=
572 new Wide_Wide_String'
573 (Wide_Wide_Fixed.Head
574 (Source.Reference (1 .. Source.Last), Count, Pad));
575 Source.Last := Source.Reference'Length;
576 Free (Old);
577 end Head;
579 -----------
580 -- Index --
581 -----------
583 function Index
584 (Source : Unbounded_Wide_Wide_String;
585 Pattern : Wide_Wide_String;
586 Going : Strings.Direction := Strings.Forward;
587 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
588 Wide_Wide_Maps.Identity)
589 return Natural
591 begin
592 return
593 Wide_Wide_Search.Index
594 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
595 end Index;
597 function Index
598 (Source : Unbounded_Wide_Wide_String;
599 Pattern : Wide_Wide_String;
600 Going : Direction := Forward;
601 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
602 return Natural
604 begin
605 return
606 Wide_Wide_Search.Index
607 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
608 end Index;
610 function Index
611 (Source : Unbounded_Wide_Wide_String;
612 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
613 Test : Strings.Membership := Strings.Inside;
614 Going : Strings.Direction := Strings.Forward) return Natural
616 begin
617 return Wide_Wide_Search.Index
618 (Source.Reference (1 .. Source.Last), Set, Test, Going);
619 end Index;
621 function Index
622 (Source : Unbounded_Wide_Wide_String;
623 Pattern : Wide_Wide_String;
624 From : Positive;
625 Going : Direction := Forward;
626 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
627 Wide_Wide_Maps.Identity)
628 return Natural
630 begin
631 return
632 Wide_Wide_Search.Index
633 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
634 end Index;
636 function Index
637 (Source : Unbounded_Wide_Wide_String;
638 Pattern : Wide_Wide_String;
639 From : Positive;
640 Going : Direction := Forward;
641 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
642 return Natural
644 begin
645 return
646 Wide_Wide_Search.Index
647 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
648 end Index;
650 function Index
651 (Source : Unbounded_Wide_Wide_String;
652 Set : Wide_Wide_Maps.Wide_Wide_Character_Set;
653 From : Positive;
654 Test : Membership := Inside;
655 Going : Direction := Forward) return Natural
657 begin
658 return
659 Wide_Wide_Search.Index
660 (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
661 end Index;
663 function Index_Non_Blank
664 (Source : Unbounded_Wide_Wide_String;
665 Going : Strings.Direction := Strings.Forward) return Natural
667 begin
668 return
669 Wide_Wide_Search.Index_Non_Blank
670 (Source.Reference (1 .. Source.Last), Going);
671 end Index_Non_Blank;
673 function Index_Non_Blank
674 (Source : Unbounded_Wide_Wide_String;
675 From : Positive;
676 Going : Direction := Forward) return Natural
678 begin
679 return
680 Wide_Wide_Search.Index_Non_Blank
681 (Source.Reference (1 .. Source.Last), From, Going);
682 end Index_Non_Blank;
684 ----------------
685 -- Initialize --
686 ----------------
688 procedure Initialize (Object : in out Unbounded_Wide_Wide_String) is
689 begin
690 Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
691 Object.Last := 0;
692 end Initialize;
694 ------------
695 -- Insert --
696 ------------
698 function Insert
699 (Source : Unbounded_Wide_Wide_String;
700 Before : Positive;
701 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
703 begin
704 return
705 To_Unbounded_Wide_Wide_String
706 (Wide_Wide_Fixed.Insert
707 (Source.Reference (1 .. Source.Last), Before, New_Item));
708 end Insert;
710 procedure Insert
711 (Source : in out Unbounded_Wide_Wide_String;
712 Before : Positive;
713 New_Item : Wide_Wide_String)
715 begin
716 if Before not in Source.Reference'First .. Source.Last + 1 then
717 raise Index_Error;
718 end if;
720 Realloc_For_Chunk (Source, New_Item'Size);
722 Source.Reference
723 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
724 Source.Reference (Before .. Source.Last);
726 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
727 Source.Last := Source.Last + New_Item'Length;
728 end Insert;
730 ------------
731 -- Length --
732 ------------
734 function Length (Source : Unbounded_Wide_Wide_String) return Natural is
735 begin
736 return Source.Last;
737 end Length;
739 ---------------
740 -- Overwrite --
741 ---------------
743 function Overwrite
744 (Source : Unbounded_Wide_Wide_String;
745 Position : Positive;
746 New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
748 begin
749 return
750 To_Unbounded_Wide_Wide_String
751 (Wide_Wide_Fixed.Overwrite
752 (Source.Reference (1 .. Source.Last), Position, New_Item));
753 end Overwrite;
755 procedure Overwrite
756 (Source : in out Unbounded_Wide_Wide_String;
757 Position : Positive;
758 New_Item : Wide_Wide_String)
760 NL : constant Natural := New_Item'Length;
761 begin
762 if Position <= Source.Last - NL + 1 then
763 Source.Reference (Position .. Position + NL - 1) := New_Item;
764 else
765 declare
766 Old : Wide_Wide_String_Access := Source.Reference;
767 begin
768 Source.Reference := new Wide_Wide_String'
769 (Wide_Wide_Fixed.Overwrite
770 (Source.Reference (1 .. Source.Last), Position, New_Item));
771 Source.Last := Source.Reference'Length;
772 Free (Old);
773 end;
774 end if;
775 end Overwrite;
777 -----------------------
778 -- Realloc_For_Chunk --
779 -----------------------
781 procedure Realloc_For_Chunk
782 (Source : in out Unbounded_Wide_Wide_String;
783 Chunk_Size : Natural)
785 Growth_Factor : constant := 32;
786 -- The growth factor controls how much extra space is allocated when
787 -- we have to increase the size of an allocated unbounded string. By
788 -- allocating extra space, we avoid the need to reallocate on every
789 -- append, particularly important when a string is built up by repeated
790 -- append operations of small pieces. This is expressed as a factor so
791 -- 32 means add 1/32 of the length of the string as growth space.
793 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
794 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
795 -- no memory loss as most (all?) malloc implementations are obliged to
796 -- align the returned memory on the maximum alignment as malloc does not
797 -- know the target alignment.
799 S_Length : constant Natural := Source.Reference'Length;
801 begin
802 if Chunk_Size > S_Length - Source.Last then
803 declare
804 New_Size : constant Positive :=
805 S_Length + Chunk_Size + (S_Length / Growth_Factor);
807 New_Rounded_Up_Size : constant Positive :=
808 ((New_Size - 1) / Min_Mul_Alloc + 1) *
809 Min_Mul_Alloc;
811 Tmp : constant Wide_Wide_String_Access :=
812 new Wide_Wide_String (1 .. New_Rounded_Up_Size);
814 begin
815 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
816 Free (Source.Reference);
817 Source.Reference := Tmp;
818 end;
819 end if;
820 end Realloc_For_Chunk;
822 ---------------------
823 -- Replace_Element --
824 ---------------------
826 procedure Replace_Element
827 (Source : in out Unbounded_Wide_Wide_String;
828 Index : Positive;
829 By : Wide_Wide_Character)
831 begin
832 if Index <= Source.Last then
833 Source.Reference (Index) := By;
834 else
835 raise Strings.Index_Error;
836 end if;
837 end Replace_Element;
839 -------------------
840 -- Replace_Slice --
841 -------------------
843 function Replace_Slice
844 (Source : Unbounded_Wide_Wide_String;
845 Low : Positive;
846 High : Natural;
847 By : Wide_Wide_String) return Unbounded_Wide_Wide_String
849 begin
850 return To_Unbounded_Wide_Wide_String
851 (Wide_Wide_Fixed.Replace_Slice
852 (Source.Reference (1 .. Source.Last), Low, High, By));
853 end Replace_Slice;
855 procedure Replace_Slice
856 (Source : in out Unbounded_Wide_Wide_String;
857 Low : Positive;
858 High : Natural;
859 By : Wide_Wide_String)
861 Old : Wide_Wide_String_Access := Source.Reference;
862 begin
863 Source.Reference := new Wide_Wide_String'
864 (Wide_Wide_Fixed.Replace_Slice
865 (Source.Reference (1 .. Source.Last), Low, High, By));
866 Source.Last := Source.Reference'Length;
867 Free (Old);
868 end Replace_Slice;
870 ------------------------------------
871 -- Set_Unbounded_Wide_Wide_String --
872 ------------------------------------
874 procedure Set_Unbounded_Wide_Wide_String
875 (Target : out Unbounded_Wide_Wide_String;
876 Source : Wide_Wide_String)
878 begin
879 Target.Last := Source'Length;
880 Target.Reference := new Wide_Wide_String (1 .. Source'Length);
881 Target.Reference.all := Source;
882 end Set_Unbounded_Wide_Wide_String;
884 -----------
885 -- Slice --
886 -----------
888 function Slice
889 (Source : Unbounded_Wide_Wide_String;
890 Low : Positive;
891 High : Natural) return Wide_Wide_String
893 begin
894 -- Note: test of High > Length is in accordance with AI95-00128
896 if Low > Source.Last + 1 or else High > Source.Last then
897 raise Index_Error;
898 else
899 return Source.Reference (Low .. High);
900 end if;
901 end Slice;
903 ----------
904 -- Tail --
905 ----------
907 function Tail
908 (Source : Unbounded_Wide_Wide_String;
909 Count : Natural;
910 Pad : Wide_Wide_Character := Wide_Wide_Space)
911 return Unbounded_Wide_Wide_String is
912 begin
913 return To_Unbounded_Wide_Wide_String
914 (Wide_Wide_Fixed.Tail
915 (Source.Reference (1 .. Source.Last), Count, Pad));
916 end Tail;
918 procedure Tail
919 (Source : in out Unbounded_Wide_Wide_String;
920 Count : Natural;
921 Pad : Wide_Wide_Character := Wide_Wide_Space)
923 Old : Wide_Wide_String_Access := Source.Reference;
924 begin
925 Source.Reference := new Wide_Wide_String'
926 (Wide_Wide_Fixed.Tail
927 (Source.Reference (1 .. Source.Last), Count, Pad));
928 Source.Last := Source.Reference'Length;
929 Free (Old);
930 end Tail;
932 -----------------------------------
933 -- To_Unbounded_Wide_Wide_String --
934 -----------------------------------
936 function To_Unbounded_Wide_Wide_String
937 (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
939 Result : Unbounded_Wide_Wide_String;
940 begin
941 Result.Last := Source'Length;
942 Result.Reference := new Wide_Wide_String (1 .. Source'Length);
943 Result.Reference.all := Source;
944 return Result;
945 end To_Unbounded_Wide_Wide_String;
947 function To_Unbounded_Wide_Wide_String
948 (Length : Natural) return Unbounded_Wide_Wide_String
950 Result : Unbounded_Wide_Wide_String;
951 begin
952 Result.Last := Length;
953 Result.Reference := new Wide_Wide_String (1 .. Length);
954 return Result;
955 end To_Unbounded_Wide_Wide_String;
957 -------------------------
958 -- To_Wide_Wide_String --
959 -------------------------
961 function To_Wide_Wide_String
962 (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String
964 begin
965 return Source.Reference (1 .. Source.Last);
966 end To_Wide_Wide_String;
968 ---------------
969 -- Translate --
970 ---------------
972 function Translate
973 (Source : Unbounded_Wide_Wide_String;
974 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
975 return Unbounded_Wide_Wide_String
977 begin
978 return
979 To_Unbounded_Wide_Wide_String
980 (Wide_Wide_Fixed.Translate
981 (Source.Reference (1 .. Source.Last), Mapping));
982 end Translate;
984 procedure Translate
985 (Source : in out Unbounded_Wide_Wide_String;
986 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
988 begin
989 Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
990 end Translate;
992 function Translate
993 (Source : Unbounded_Wide_Wide_String;
994 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
995 return Unbounded_Wide_Wide_String
997 begin
998 return
999 To_Unbounded_Wide_Wide_String
1000 (Wide_Wide_Fixed.Translate
1001 (Source.Reference (1 .. Source.Last), Mapping));
1002 end Translate;
1004 procedure Translate
1005 (Source : in out Unbounded_Wide_Wide_String;
1006 Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
1008 begin
1009 Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1010 end Translate;
1012 ----------
1013 -- Trim --
1014 ----------
1016 function Trim
1017 (Source : Unbounded_Wide_Wide_String;
1018 Side : Trim_End) return Unbounded_Wide_Wide_String
1020 begin
1021 return
1022 To_Unbounded_Wide_Wide_String
1023 (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1024 end Trim;
1026 procedure Trim
1027 (Source : in out Unbounded_Wide_Wide_String;
1028 Side : Trim_End)
1030 Old : Wide_Wide_String_Access := Source.Reference;
1031 begin
1032 Source.Reference :=
1033 new Wide_Wide_String'
1034 (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1035 Source.Last := Source.Reference'Length;
1036 Free (Old);
1037 end Trim;
1039 function Trim
1040 (Source : Unbounded_Wide_Wide_String;
1041 Left : Wide_Wide_Maps.Wide_Wide_Character_Set;
1042 Right : Wide_Wide_Maps.Wide_Wide_Character_Set)
1043 return Unbounded_Wide_Wide_String
1045 begin
1046 return
1047 To_Unbounded_Wide_Wide_String
1048 (Wide_Wide_Fixed.Trim
1049 (Source.Reference (1 .. Source.Last), Left, Right));
1050 end Trim;
1052 procedure Trim
1053 (Source : in out Unbounded_Wide_Wide_String;
1054 Left : Wide_Wide_Maps.Wide_Wide_Character_Set;
1055 Right : Wide_Wide_Maps.Wide_Wide_Character_Set)
1057 Old : Wide_Wide_String_Access := Source.Reference;
1058 begin
1059 Source.Reference :=
1060 new Wide_Wide_String'
1061 (Wide_Wide_Fixed.Trim
1062 (Source.Reference (1 .. Source.Last), Left, Right));
1063 Source.Last := Source.Reference'Length;
1064 Free (Old);
1065 end Trim;
1067 ---------------------
1068 -- Unbounded_Slice --
1069 ---------------------
1071 function Unbounded_Slice
1072 (Source : Unbounded_Wide_Wide_String;
1073 Low : Positive;
1074 High : Natural) return Unbounded_Wide_Wide_String
1076 begin
1077 if Low > Source.Last + 1 or else High > Source.Last then
1078 raise Index_Error;
1079 else
1080 return
1081 To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
1082 end if;
1083 end Unbounded_Slice;
1085 procedure Unbounded_Slice
1086 (Source : Unbounded_Wide_Wide_String;
1087 Target : out Unbounded_Wide_Wide_String;
1088 Low : Positive;
1089 High : Natural)
1091 begin
1092 if Low > Source.Last + 1 or else High > Source.Last then
1093 raise Index_Error;
1094 else
1095 Target :=
1096 To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
1097 end if;
1098 end Unbounded_Slice;
1100 end Ada.Strings.Wide_Wide_Unbounded;