?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* config/arm/elf.h (ASM_OUTPUT_ALIGNED_COMMON): Remove definition.
[official-gcc.git] / gcc / ada / a-stwibo.adb
blob982ca638c717817ca0b0fcbf767b3a565564dafd
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . W I D E _ B O U N D E D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 ------------------------------------------------------------------------------
33
34 with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
35 with Ada.Strings.Wide_Search;
36
37 package body Ada.Strings.Wide_Bounded is
38
39 package body Generic_Bounded_Length is
40
41 ---------
42 -- "&" --
43 ---------
44
45 function "&"
46 (Left : in Bounded_Wide_String;
47 Right : in Bounded_Wide_String)
48 return Bounded_Wide_String
49 is
50 Result : Bounded_Wide_String;
51 Llen : constant Length_Range := Left.Length;
52 Rlen : constant Length_Range := Right.Length;
53 Nlen : constant Natural := Llen + Rlen;
54
55 begin
56 if Nlen > Max_Length then
57 raise Ada.Strings.Length_Error;
58 else
59 Result.Length := Nlen;
60 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
61 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
62 end if;
63
64 return Result;
65 end "&";
66
67 function "&"
68 (Left : in Bounded_Wide_String;
69 Right : in Wide_String)
70 return Bounded_Wide_String
71 is
72 Result : Bounded_Wide_String;
73 Llen : constant Length_Range := Left.Length;
74
75 Nlen : constant Natural := Llen + Right'Length;
76
77 begin
78 if Nlen > Max_Length then
79 raise Ada.Strings.Length_Error;
80 else
81 Result.Length := Nlen;
82 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
83 Result.Data (Llen + 1 .. Nlen) := Right;
84 end if;
85 return Result;
86 end "&";
87
88 function "&"
89 (Left : in Wide_String;
90 Right : in Bounded_Wide_String)
91 return Bounded_Wide_String
92 is
93 Result : Bounded_Wide_String;
94 Llen : constant Length_Range := Left'Length;
95 Rlen : constant Length_Range := Right.Length;
96 Nlen : constant Natural := Llen + Rlen;
97
98 begin
99 if Nlen > Max_Length then
100 raise Ada.Strings.Length_Error;
101 else
102 Result.Length := Nlen;
103 Result.Data (1 .. Llen) := Left;
104 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
105 end if;
106
107 return Result;
108 end "&";
109
110 function "&"
111 (Left : in Bounded_Wide_String;
112 Right : in Wide_Character)
113 return Bounded_Wide_String
114 is
115 Result : Bounded_Wide_String;
116 Llen : constant Length_Range := Left.Length;
117
118 begin
119 if Llen = Max_Length then
120 raise Ada.Strings.Length_Error;
121 else
122 Result.Length := Llen + 1;
123 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
124 Result.Data (Result.Length) := Right;
125 end if;
126
127 return Result;
128 end "&";
129
130 function "&"
131 (Left : in Wide_Character;
132 Right : in Bounded_Wide_String)
133 return Bounded_Wide_String
134 is
135 Result : Bounded_Wide_String;
136 Rlen : Length_Range := Right.Length;
137
138 begin
139 if Rlen = Max_Length then
140 raise Ada.Strings.Length_Error;
141 else
142 Result.Length := Rlen + 1;
143 Result.Data (1) := Left;
144 Result.Data (2 .. Result.Length) := Right.Data (1 .. Rlen);
145 end if;
146
147 return Result;
148 end "&";
149
150 ---------
151 -- "*" --
152 ---------
153
154 function "*"
155 (Left : in Natural;
156 Right : in Wide_Character)
157 return Bounded_Wide_String
158 is
159 Result : Bounded_Wide_String;
160
161 begin
162 if Left > Max_Length then
163 raise Ada.Strings.Length_Error;
164 else
165 Result.Length := Left;
166
167 for J in 1 .. Left loop
168 Result.Data (J) := Right;
169 end loop;
170 end if;
171
172 return Result;
173 end "*";
174
175 function "*"
176 (Left : in Natural;
177 Right : in Wide_String)
178 return Bounded_Wide_String
179 is
180 Result : Bounded_Wide_String;
181 Pos : Positive := 1;
182 Rlen : constant Natural := Right'Length;
183 Nlen : constant Natural := Left * Rlen;
184
185 begin
186 if Nlen > Max_Length then
187 raise Ada.Strings.Index_Error;
188 else
189 Result.Length := Nlen;
190
191 if Nlen > 0 then
192 for J in 1 .. Left loop
193 Result.Data (Pos .. Pos + Rlen - 1) := Right;
194 Pos := Pos + Rlen;
195 end loop;
196 end if;
197 end if;
198
199 return Result;
200 end "*";
201
202 function "*"
203 (Left : in Natural;
204 Right : in Bounded_Wide_String)
205 return Bounded_Wide_String
206 is
207 Result : Bounded_Wide_String;
208 Pos : Positive := 1;
209 Rlen : constant Length_Range := Right.Length;
210 Nlen : constant Natural := Left * Rlen;
211
212 begin
213 if Nlen > Max_Length then
214 raise Ada.Strings.Length_Error;
215
216 else
217 Result.Length := Nlen;
218
219 if Nlen > 0 then
220 for J in 1 .. Left loop
221 Result.Data (Pos .. Pos + Rlen - 1) :=
222 Right.Data (1 .. Rlen);
223 Pos := Pos + Rlen;
224 end loop;
225 end if;
226 end if;
227
228 return Result;
229 end "*";
230
231 ---------
232 -- "<" --
233 ---------
234
235 function "<"
236 (Left : in Bounded_Wide_String;
237 Right : in Bounded_Wide_String)
238 return Boolean
239 is
240 begin
241 return Left.Data (1 .. Left.Length) < Right.Data (1 .. Right.Length);
242 end "<";
243
244 function "<"
245 (Left : in Bounded_Wide_String;
246 Right : in Wide_String)
247 return Boolean
248 is
249 begin
250 return Left.Data (1 .. Left.Length) < Right;
251 end "<";
252
253 function "<"
254 (Left : in Wide_String;
255 Right : in Bounded_Wide_String)
256 return Boolean
257 is
258 begin
259 return Left < Right.Data (1 .. Right.Length);
260 end "<";
261
262 ----------
263 -- "<=" --
264 ----------
265
266 function "<="
267 (Left : in Bounded_Wide_String;
268 Right : in Bounded_Wide_String)
269 return Boolean
270 is
271 begin
272 return Left.Data (1 .. Left.Length) <= Right.Data (1 .. Right.Length);
273 end "<=";
274
275 function "<="
276 (Left : in Bounded_Wide_String;
277 Right : in Wide_String)
278 return Boolean
279 is
280 begin
281 return Left.Data (1 .. Left.Length) <= Right;
282 end "<=";
283
284 function "<="
285 (Left : in Wide_String;
286 Right : in Bounded_Wide_String)
287 return Boolean
288 is
289 begin
290 return Left <= Right.Data (1 .. Right.Length);
291 end "<=";
292
293 ---------
294 -- "=" --
295 ---------
296
297 function "="
298 (Left : in Bounded_Wide_String;
299 Right : in Bounded_Wide_String)
300 return Boolean
301 is
302 begin
303 return Left.Length = Right.Length
304 and then Left.Data (1 .. Left.Length) =
305 Right.Data (1 .. Right.Length);
306 end "=";
307
308 function "="
309 (Left : in Bounded_Wide_String;
310 Right : in Wide_String)
311 return Boolean
312 is
313 begin
314 return Left.Length = Right'Length
315 and then Left.Data (1 .. Left.Length) = Right;
316 end "=";
317
318 function "="
319 (Left : in Wide_String;
320 Right : in Bounded_Wide_String)
321 return Boolean
322 is
323 begin
324 return Left'Length = Right.Length
325 and then Left = Right.Data (1 .. Right.Length);
326 end "=";
327
328 ---------
329 -- ">" --
330 ---------
331
332 function ">"
333 (Left : in Bounded_Wide_String;
334 Right : in Bounded_Wide_String)
335 return Boolean
336 is
337 begin
338 return Left.Data (1 .. Left.Length) > Right.Data (1 .. Right.Length);
339 end ">";
340
341 function ">"
342 (Left : in Bounded_Wide_String;
343 Right : in Wide_String)
344 return Boolean
345 is
346 begin
347 return Left.Data (1 .. Left.Length) > Right;
348 end ">";
349
350 function ">"
351 (Left : in Wide_String;
352 Right : in Bounded_Wide_String)
353 return Boolean
354 is
355 begin
356 return Left > Right.Data (1 .. Right.Length);
357 end ">";
358
359 ----------
360 -- ">=" --
361 ----------
362
363 function ">="
364 (Left : in Bounded_Wide_String;
365 Right : in Bounded_Wide_String)
366 return Boolean
367 is
368 begin
369 return Left.Data (1 .. Left.Length) >= Right.Data (1 .. Right.Length);
370 end ">=";
371
372 function ">="
373 (Left : in Bounded_Wide_String;
374 Right : in Wide_String)
375 return Boolean
376 is
377 begin
378 return Left.Data (1 .. Left.Length) >= Right;
379 end ">=";
380
381 function ">="
382 (Left : in Wide_String;
383 Right : in Bounded_Wide_String)
384 return Boolean
385 is
386 begin
387 return Left >= Right.Data (1 .. Right.Length);
388 end ">=";
389
390 ------------
391 -- Append --
392 ------------
393
394 -- Case of Bounded_Wide_String and Bounded_Wide_String
395
396 function Append
397 (Left, Right : in Bounded_Wide_String;
398 Drop : in Strings.Truncation := Strings.Error)
399 return Bounded_Wide_String
400 is
401 Result : Bounded_Wide_String;
402 Llen : constant Length_Range := Left.Length;
403 Rlen : constant Length_Range := Right.Length;
404 Nlen : constant Natural := Llen + Rlen;
405
406 begin
407 if Nlen <= Max_Length then
408 Result.Length := Nlen;
409 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
410 Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
411
412 else
413 Result.Length := Max_Length;
414
415 case Drop is
416 when Strings.Right =>
417 if Llen >= Max_Length then -- only case is Llen = Max_Length
418 Result.Data := Right.Data;
419
420 else
421 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
422 Result.Data (Llen + 1 .. Max_Length) :=
423 Right.Data (1 .. Max_Length - Llen);
424 end if;
425
426 when Strings.Left =>
427 if Rlen >= Max_Length then -- only case is Rlen = Max_Length
428 Result.Data := Right.Data;
429
430 else
431 Result.Data (1 .. Max_Length - Rlen) :=
432 Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
433 Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
434 Right.Data (1 .. Rlen);
435 end if;
436
437 when Strings.Error =>
438 raise Ada.Strings.Length_Error;
439 end case;
440 end if;
441
442 return Result;
443 end Append;
444
445 procedure Append
446 (Source : in out Bounded_Wide_String;
447 New_Item : in Bounded_Wide_String;
448 Drop : in Truncation := Error)
449 is
450 Llen : constant Length_Range := Source.Length;
451 Rlen : constant Length_Range := New_Item.Length;
452 Nlen : constant Natural := Llen + Rlen;
453
454 begin
455 if Nlen <= Max_Length then
456 Source.Length := Nlen;
457 Source.Data (Llen + 1 .. Nlen) := New_Item.Data (1 .. Rlen);
458
459 else
460 Source.Length := Max_Length;
461
462 case Drop is
463 when Strings.Right =>
464 if Llen < Max_Length then
465 Source.Data (Llen + 1 .. Max_Length) :=
466 New_Item.Data (1 .. Max_Length - Llen);
467 end if;
468
469 when Strings.Left =>
470 if Rlen >= Max_Length then -- only case is Rlen = Max_Length
471 Source.Data := New_Item.Data;
472
473 else
474 Source.Data (1 .. Max_Length - Rlen) :=
475 Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
476 Source.Data (Max_Length - Rlen + 1 .. Max_Length) :=
477 New_Item.Data (1 .. Rlen);
478 end if;
479
480 when Strings.Error =>
481 raise Ada.Strings.Length_Error;
482 end case;
483 end if;
484
485 end Append;
486
487 -- Case of Bounded_Wide_String and Wide_String
488
489 function Append
490 (Left : in Bounded_Wide_String;
491 Right : in Wide_String;
492 Drop : in Strings.Truncation := Strings.Error)
493 return Bounded_Wide_String
494 is
495 Result : Bounded_Wide_String;
496 Llen : constant Length_Range := Left.Length;
497 Rlen : constant Length_Range := Right'Length;
498 Nlen : constant Natural := Llen + Rlen;
499
500 begin
501 if Nlen <= Max_Length then
502 Result.Length := Nlen;
503 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
504 Result.Data (Llen + 1 .. Nlen) := Right;
505
506 else
507 Result.Length := Max_Length;
508
509 case Drop is
510 when Strings.Right =>
511 if Llen >= Max_Length then -- only case is Llen = Max_Length
512 Result.Data := Left.Data;
513
514 else
515 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
516 Result.Data (Llen + 1 .. Max_Length) :=
517 Right (Right'First .. Right'First - 1 +
518 Max_Length - Llen);
519
520 end if;
521
522 when Strings.Left =>
523 if Rlen >= Max_Length then
524 Result.Data (1 .. Max_Length) :=
525 Right (Right'Last - (Max_Length - 1) .. Right'Last);
526
527 else
528 Result.Data (1 .. Max_Length - Rlen) :=
529 Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
530 Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
531 Right;
532 end if;
533
534 when Strings.Error =>
535 raise Ada.Strings.Length_Error;
536 end case;
537 end if;
538
539 return Result;
540 end Append;
541
542 procedure Append
543 (Source : in out Bounded_Wide_String;
544 New_Item : in Wide_String;
545 Drop : in Truncation := Error)
546 is
547 Llen : constant Length_Range := Source.Length;
548 Rlen : constant Length_Range := New_Item'Length;
549 Nlen : constant Natural := Llen + Rlen;
550
551 begin
552 if Nlen <= Max_Length then
553 Source.Length := Nlen;
554 Source.Data (Llen + 1 .. Nlen) := New_Item;
555
556 else
557 Source.Length := Max_Length;
558
559 case Drop is
560 when Strings.Right =>
561 if Llen < Max_Length then
562 Source.Data (Llen + 1 .. Max_Length) :=
563 New_Item (New_Item'First ..
564 New_Item'First - 1 + Max_Length - Llen);
565 end if;
566
567 when Strings.Left =>
568 if Rlen >= Max_Length then
569 Source.Data (1 .. Max_Length) :=
570 New_Item (New_Item'Last - (Max_Length - 1) ..
571 New_Item'Last);
572
573 else
574 Source.Data (1 .. Max_Length - Rlen) :=
575 Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen);
576 Source.Data (Max_Length - Rlen + 1 .. Max_Length) :=
577 New_Item;
578 end if;
579
580 when Strings.Error =>
581 raise Ada.Strings.Length_Error;
582 end case;
583 end if;
584
585 end Append;
586
587 -- Case of Wide_String and Bounded_Wide_String
588
589 function Append
590 (Left : in Wide_String;
591 Right : in Bounded_Wide_String;
592 Drop : in Strings.Truncation := Strings.Error)
593 return Bounded_Wide_String
594 is
595 Result : Bounded_Wide_String;
596 Llen : constant Length_Range := Left'Length;
597 Rlen : constant Length_Range := Right.Length;
598 Nlen : constant Natural := Llen + Rlen;
599
600 begin
601 if Nlen <= Max_Length then
602 Result.Length := Nlen;
603 Result.Data (1 .. Llen) := Left;
604 Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen);
605
606 else
607 Result.Length := Max_Length;
608
609 case Drop is
610 when Strings.Right =>
611 if Llen >= Max_Length then
612 Result.Data (1 .. Max_Length) :=
613 Left (Left'First .. Left'First + (Max_Length - 1));
614
615 else
616 Result.Data (1 .. Llen) := Left;
617 Result.Data (Llen + 1 .. Max_Length) :=
618 Right.Data (1 .. Max_Length - Llen);
619 end if;
620
621 when Strings.Left =>
622 if Rlen >= Max_Length then
623 Result.Data (1 .. Max_Length) :=
624 Right.Data (Rlen - (Max_Length - 1) .. Rlen);
625
626 else
627 Result.Data (1 .. Max_Length - Rlen) :=
628 Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last);
629 Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
630 Right.Data (1 .. Rlen);
631 end if;
632
633 when Strings.Error =>
634 raise Ada.Strings.Length_Error;
635 end case;
636 end if;
637
638 return Result;
639 end Append;
640
641 -- Case of Bounded_Wide_String and Wide_Character
642
643 function Append
644 (Left : in Bounded_Wide_String;
645 Right : in Wide_Character;
646 Drop : in Strings.Truncation := Strings.Error)
647 return Bounded_Wide_String
648 is
649 Result : Bounded_Wide_String;
650 Llen : constant Length_Range := Left.Length;
651
652 begin
653 if Llen < Max_Length then
654 Result.Length := Llen + 1;
655 Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
656 Result.Data (Llen + 1) := Right;
657 return Result;
658
659 else
660 case Drop is
661 when Strings.Right =>
662 return Left;
663
664 when Strings.Left =>
665 Result.Length := Max_Length;
666 Result.Data (1 .. Max_Length - 1) :=
667 Left.Data (2 .. Max_Length);
668 Result.Data (Max_Length) := Right;
669 return Result;
670
671 when Strings.Error =>
672 raise Ada.Strings.Length_Error;
673 end case;
674 end if;
675 end Append;
676
677 procedure Append
678 (Source : in out Bounded_Wide_String;
679 New_Item : in Wide_Character;
680 Drop : in Truncation := Error)
681 is
682 Llen : constant Length_Range := Source.Length;
683
684 begin
685 if Llen < Max_Length then
686 Source.Length := Llen + 1;
687 Source.Data (Llen + 1) := New_Item;
688
689 else
690 Source.Length := Max_Length;
691
692 case Drop is
693 when Strings.Right =>
694 null;
695
696 when Strings.Left =>
697 Source.Data (1 .. Max_Length - 1) :=
698 Source.Data (2 .. Max_Length);
699 Source.Data (Max_Length) := New_Item;
700
701 when Strings.Error =>
702 raise Ada.Strings.Length_Error;
703 end case;
704 end if;
705
706 end Append;
707
708 -- Case of Wide_Character and Bounded_Wide_String
709
710 function Append
711 (Left : in Wide_Character;
712 Right : in Bounded_Wide_String;
713 Drop : in Strings.Truncation := Strings.Error)
714 return Bounded_Wide_String
715 is
716 Result : Bounded_Wide_String;
717 Rlen : constant Length_Range := Right.Length;
718
719 begin
720 if Rlen < Max_Length then
721 Result.Length := Rlen + 1;
722 Result.Data (1) := Left;
723 Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen);
724 return Result;
725
726 else
727 case Drop is
728 when Strings.Right =>
729 Result.Length := Max_Length;
730 Result.Data (1) := Left;
731 Result.Data (2 .. Max_Length) :=
732 Right.Data (1 .. Max_Length - 1);
733 return Result;
734
735 when Strings.Left =>
736 return Right;
737
738 when Strings.Error =>
739 raise Ada.Strings.Length_Error;
740 end case;
741 end if;
742 end Append;
743
744 -----------
745 -- Count --
746 -----------
747
748 function Count
749 (Source : in Bounded_Wide_String;
750 Pattern : in Wide_String;
751 Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
752 return Natural
753 is
754 begin
755 return
756 Wide_Search.Count
757 (Source.Data (1 .. Source.Length), Pattern, Mapping);
758 end Count;
759
760 function Count
761 (Source : in Bounded_Wide_String;
762 Pattern : in Wide_String;
763 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
764 return Natural
765 is
766 begin
767 return
768 Wide_Search.Count
769 (Source.Data (1 .. Source.Length), Pattern, Mapping);
770 end Count;
771
772 function Count
773 (Source : in Bounded_Wide_String;
774 Set : in Wide_Maps.Wide_Character_Set)
775 return Natural
776 is
777 begin
778 return Wide_Search.Count (Source.Data (1 .. Source.Length), Set);
779 end Count;
780
781 ------------
782 -- Delete --
783 ------------
784
785 function Delete
786 (Source : in Bounded_Wide_String;
787 From : in Positive;
788 Through : in Natural)
789 return Bounded_Wide_String
790 is
791 Slen : constant Natural := Source.Length;
792 Num_Delete : constant Integer := Through - From + 1;
793 Result : Bounded_Wide_String;
794
795 begin
796 if Num_Delete <= 0 then
797 return Source;
798
799 elsif From > Slen + 1 then
800 raise Ada.Strings.Index_Error;
801
802 elsif Through >= Slen then
803 Result.Length := From - 1;
804 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
805 return Result;
806
807 else
808 Result.Length := Slen - Num_Delete;
809 Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1);
810 Result.Data (From .. Result.Length) :=
811 Source.Data (Through + 1 .. Slen);
812 return Result;
813 end if;
814 end Delete;
815
816 procedure Delete
817 (Source : in out Bounded_Wide_String;
818 From : in Positive;
819 Through : in Natural)
820 is
821 Slen : constant Natural := Source.Length;
822 Num_Delete : constant Integer := Through - From + 1;
823
824 begin
825 if Num_Delete <= 0 then
826 return;
827
828 elsif From > Slen + 1 then
829 raise Ada.Strings.Index_Error;
830
831 elsif Through >= Slen then
832 Source.Length := From - 1;
833
834 else
835 Source.Length := Slen - Num_Delete;
836 Source.Data (From .. Source.Length) :=
837 Source.Data (Through + 1 .. Slen);
838 end if;
839 end Delete;
840
841 -------------
842 -- Element --
843 -------------
844
845 function Element
846 (Source : in Bounded_Wide_String;
847 Index : in Positive)
848 return Wide_Character
849 is
850 begin
851 if Index in 1 .. Source.Length then
852 return Source.Data (Index);
853 else
854 raise Strings.Index_Error;
855 end if;
856 end Element;
857
858 ----------------
859 -- Find_Token --
860 ----------------
861
862 procedure Find_Token
863 (Source : in Bounded_Wide_String;
864 Set : in Wide_Maps.Wide_Character_Set;
865 Test : in Strings.Membership;
866 First : out Positive;
867 Last : out Natural)
868 is
869 begin
870 Wide_Search.Find_Token
871 (Source.Data (1 .. Source.Length), Set, Test, First, Last);
872 end Find_Token;
873
874
875 ----------
876 -- Head --
877 ----------
878
879 function Head
880 (Source : in Bounded_Wide_String;
881 Count : in Natural;
882 Pad : in Wide_Character := Wide_Space;
883 Drop : in Strings.Truncation := Strings.Error)
884 return Bounded_Wide_String
885 is
886 Result : Bounded_Wide_String;
887 Slen : constant Natural := Source.Length;
888 Npad : constant Integer := Count - Slen;
889
890 begin
891 if Npad <= 0 then
892 Result.Length := Count;
893 Result.Data (1 .. Count) := Source.Data (1 .. Count);
894
895 elsif Count <= Max_Length then
896 Result.Length := Count;
897 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
898 Result.Data (Slen + 1 .. Count) := (others => Pad);
899
900 else
901 Result.Length := Max_Length;
902
903 case Drop is
904 when Strings.Right =>
905 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
906 Result.Data (Slen + 1 .. Max_Length) := (others => Pad);
907
908 when Strings.Left =>
909 if Npad >= Max_Length then
910 Result.Data := (others => Pad);
911
912 else
913 Result.Data (1 .. Max_Length - Npad) :=
914 Source.Data (Count - Max_Length + 1 .. Slen);
915 Result.Data (Max_Length - Npad + 1 .. Max_Length) :=
916 (others => Pad);
917 end if;
918
919 when Strings.Error =>
920 raise Ada.Strings.Length_Error;
921 end case;
922 end if;
923
924 return Result;
925 end Head;
926
927 procedure Head
928 (Source : in out Bounded_Wide_String;
929 Count : in Natural;
930 Pad : in Wide_Character := Wide_Space;
931 Drop : in Truncation := Error)
932 is
933 Slen : constant Natural := Source.Length;
934 Npad : constant Integer := Count - Slen;
935 Temp : Wide_String (1 .. Max_Length);
936
937 begin
938 if Npad <= 0 then
939 Source.Length := Count;
940
941 elsif Count <= Max_Length then
942 Source.Length := Count;
943 Source.Data (Slen + 1 .. Count) := (others => Pad);
944
945 else
946 Source.Length := Max_Length;
947
948 case Drop is
949 when Strings.Right =>
950 Source.Data (Slen + 1 .. Max_Length) := (others => Pad);
951
952 when Strings.Left =>
953 if Npad > Max_Length then
954 Source.Data := (others => Pad);
955
956 else
957 Temp := Source.Data;
958 Source.Data (1 .. Max_Length - Npad) :=
959 Temp (Count - Max_Length + 1 .. Slen);
960
961 for J in Max_Length - Npad + 1 .. Max_Length loop
962 Source.Data (J) := Pad;
963 end loop;
964 end if;
965
966 when Strings.Error =>
967 raise Ada.Strings.Length_Error;
968 end case;
969 end if;
970
971 end Head;
972
973 -----------
974 -- Index --
975 -----------
976
977 function Index
978 (Source : in Bounded_Wide_String;
979 Pattern : in Wide_String;
980 Going : in Strings.Direction := Strings.Forward;
981 Mapping : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
982 return Natural
983 is
984 begin
985 return Wide_Search.Index
986 (Source.Data (1 .. Source.Length), Pattern, Going, Mapping);
987 end Index;
988
989 function Index
990 (Source : in Bounded_Wide_String;
991 Pattern : in Wide_String;
992 Going : in Direction := Forward;
993 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
994 return Natural
995 is
996 begin
997 return Wide_Search.Index
998 (Source.Data (1 .. Source.Length), Pattern, Going, Mapping);
999 end Index;
1000
1001 function Index
1002 (Source : in Bounded_Wide_String;
1003 Set : in Wide_Maps.Wide_Character_Set;
1004 Test : in Strings.Membership := Strings.Inside;
1005 Going : in Strings.Direction := Strings.Forward)
1006 return Natural
1007 is
1008 begin
1009 return Wide_Search.Index
1010 (Source.Data (1 .. Source.Length), Set, Test, Going);
1011 end Index;
1012
1013 ---------------------
1014 -- Index_Non_Blank --
1015 ---------------------
1016
1017 function Index_Non_Blank
1018 (Source : in Bounded_Wide_String;
1019 Going : in Strings.Direction := Strings.Forward)
1020 return Natural
1021 is
1022 begin
1023 return
1024 Wide_Search.Index_Non_Blank
1025 (Source.Data (1 .. Source.Length), Going);
1026 end Index_Non_Blank;
1027
1028 ------------
1029 -- Insert --
1030 ------------
1031
1032 function Insert
1033 (Source : in Bounded_Wide_String;
1034 Before : in Positive;
1035 New_Item : in Wide_String;
1036 Drop : in Strings.Truncation := Strings.Error)
1037 return Bounded_Wide_String
1038 is
1039 Slen : constant Natural := Source.Length;
1040 Nlen : constant Natural := New_Item'Length;
1041 Tlen : constant Natural := Slen + Nlen;
1042 Blen : constant Natural := Before - 1;
1043 Alen : constant Integer := Slen - Blen;
1044 Droplen : constant Integer := Tlen - Max_Length;
1045 Result : Bounded_Wide_String;
1046
1047 -- Tlen is the length of the total string before possible truncation.
1048 -- Blen, Alen are the lengths of the before and after pieces of the
1049 -- source string.
1050
1051 begin
1052 if Alen < 0 then
1053 raise Ada.Strings.Index_Error;
1054
1055 elsif Droplen <= 0 then
1056 Result.Length := Tlen;
1057 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1058 Result.Data (Before .. Before + Nlen - 1) := New_Item;
1059 Result.Data (Before + Nlen .. Tlen) :=
1060 Source.Data (Before .. Slen);
1061
1062 else
1063 Result.Length := Max_Length;
1064
1065 case Drop is
1066 when Strings.Right =>
1067 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1068
1069 if Droplen > Alen then
1070 Result.Data (Before .. Max_Length) :=
1071 New_Item (New_Item'First
1072 .. New_Item'First + Max_Length - Before);
1073 else
1074 Result.Data (Before .. Before + Nlen - 1) := New_Item;
1075 Result.Data (Before + Nlen .. Max_Length) :=
1076 Source.Data (Before .. Slen - Droplen);
1077 end if;
1078
1079 when Strings.Left =>
1080 Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1081 Source.Data (Before .. Slen);
1082
1083 if Droplen >= Blen then
1084 Result.Data (1 .. Max_Length - Alen) :=
1085 New_Item (New_Item'Last - (Max_Length - Alen) + 1
1086 .. New_Item'Last);
1087 else
1088 Result.Data
1089 (Blen - Droplen + 1 .. Max_Length - Alen) :=
1090 New_Item;
1091 Result.Data (1 .. Blen - Droplen) :=
1092 Source.Data (Droplen + 1 .. Blen);
1093 end if;
1094
1095 when Strings.Error =>
1096 raise Ada.Strings.Length_Error;
1097 end case;
1098 end if;
1099
1100 return Result;
1101 end Insert;
1102
1103 procedure Insert
1104 (Source : in out Bounded_Wide_String;
1105 Before : in Positive;
1106 New_Item : in Wide_String;
1107 Drop : in Strings.Truncation := Strings.Error)
1108 is
1109 begin
1110 -- We do a double copy here because this is one of the situations
1111 -- in which we move data to the right, and at least at the moment,
1112 -- GNAT is not handling such cases correctly ???
1113
1114 Source := Insert (Source, Before, New_Item, Drop);
1115 end Insert;
1116
1117 ------------
1118 -- Length --
1119 ------------
1120
1121 function Length (Source : in Bounded_Wide_String) return Length_Range is
1122 begin
1123 return Source.Length;
1124 end Length;
1125
1126 ---------------
1127 -- Overwrite --
1128 ---------------
1129
1130 function Overwrite
1131 (Source : in Bounded_Wide_String;
1132 Position : in Positive;
1133 New_Item : in Wide_String;
1134 Drop : in Strings.Truncation := Strings.Error)
1135 return Bounded_Wide_String
1136 is
1137 Result : Bounded_Wide_String;
1138 Endpos : constant Natural := Position + New_Item'Length - 1;
1139 Slen : constant Natural := Source.Length;
1140 Droplen : Natural;
1141
1142 begin
1143 if Position > Slen + 1 then
1144 raise Ada.Strings.Index_Error;
1145
1146 elsif New_Item'Length = 0 then
1147 return Source;
1148
1149 elsif Endpos <= Slen then
1150 Result.Length := Source.Length;
1151 Result.Data (1 .. Slen) := Source.Data (1 .. Slen);
1152 Result.Data (Position .. Endpos) := New_Item;
1153 return Result;
1154
1155 elsif Endpos <= Max_Length then
1156 Result.Length := Endpos;
1157 Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1);
1158 Result.Data (Position .. Endpos) := New_Item;
1159 return Result;
1160
1161 else
1162 Result.Length := Max_Length;
1163 Droplen := Endpos - Max_Length;
1164
1165 case Drop is
1166 when Strings.Right =>
1167 Result.Data (1 .. Position - 1) :=
1168 Source.Data (1 .. Position - 1);
1169
1170 Result.Data (Position .. Max_Length) :=
1171 New_Item (New_Item'First .. New_Item'Last - Droplen);
1172 return Result;
1173
1174 when Strings.Left =>
1175 if New_Item'Length >= Max_Length then
1176 Result.Data (1 .. Max_Length) :=
1177 New_Item (New_Item'Last - Max_Length + 1 ..
1178 New_Item'Last);
1179 return Result;
1180
1181 else
1182 Result.Data (1 .. Max_Length - New_Item'Length) :=
1183 Source.Data (Droplen + 1 .. Position - 1);
1184 Result.Data
1185 (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1186 New_Item;
1187 return Result;
1188 end if;
1189
1190 when Strings.Error =>
1191 raise Ada.Strings.Length_Error;
1192 end case;
1193 end if;
1194 end Overwrite;
1195
1196 procedure Overwrite
1197 (Source : in out Bounded_Wide_String;
1198 Position : in Positive;
1199 New_Item : in Wide_String;
1200 Drop : in Strings.Truncation := Strings.Error)
1201 is
1202 Endpos : constant Positive := Position + New_Item'Length - 1;
1203 Slen : constant Natural := Source.Length;
1204 Droplen : Natural;
1205
1206 begin
1207 if Position > Slen + 1 then
1208 raise Ada.Strings.Index_Error;
1209
1210 elsif Endpos <= Slen then
1211 Source.Data (Position .. Endpos) := New_Item;
1212
1213 elsif Endpos <= Max_Length then
1214 Source.Data (Position .. Endpos) := New_Item;
1215 Source.Length := Endpos;
1216
1217 else
1218 Source.Length := Max_Length;
1219 Droplen := Endpos - Max_Length;
1220
1221 case Drop is
1222 when Strings.Right =>
1223 Source.Data (Position .. Max_Length) :=
1224 New_Item (New_Item'First .. New_Item'Last - Droplen);
1225
1226 when Strings.Left =>
1227 if New_Item'Length > Max_Length then
1228 Source.Data (1 .. Max_Length) :=
1229 New_Item (New_Item'Last - Max_Length + 1 ..
1230 New_Item'Last);
1231
1232 else
1233 Source.Data (1 .. Max_Length - New_Item'Length) :=
1234 Source.Data (Droplen + 1 .. Position - 1);
1235
1236 Source.Data
1237 (Max_Length - New_Item'Length + 1 .. Max_Length) :=
1238 New_Item;
1239 end if;
1240
1241 when Strings.Error =>
1242 raise Ada.Strings.Length_Error;
1243 end case;
1244 end if;
1245 end Overwrite;
1246
1247 ---------------------
1248 -- Replace_Element --
1249 ---------------------
1250
1251 procedure Replace_Element
1252 (Source : in out Bounded_Wide_String;
1253 Index : in Positive;
1254 By : in Wide_Character)
1255 is
1256 begin
1257 if Index <= Source.Length then
1258 Source.Data (Index) := By;
1259 else
1260 raise Ada.Strings.Index_Error;
1261 end if;
1262 end Replace_Element;
1263
1264 -------------------
1265 -- Replace_Slice --
1266 -------------------
1267
1268 function Replace_Slice
1269 (Source : in Bounded_Wide_String;
1270 Low : in Positive;
1271 High : in Natural;
1272 By : in Wide_String;
1273 Drop : in Strings.Truncation := Strings.Error)
1274 return Bounded_Wide_String
1275 is
1276 Slen : constant Natural := Source.Length;
1277
1278 begin
1279 if Low > Slen + 1 then
1280 raise Strings.Index_Error;
1281
1282 elsif High < Low then
1283 return Insert (Source, Low, By, Drop);
1284
1285 else
1286 declare
1287 Blen : constant Natural := Natural'Max (0, Low - 1);
1288 Alen : constant Natural := Natural'Max (0, Slen - High);
1289 Tlen : constant Natural := Blen + By'Length + Alen;
1290 Droplen : constant Integer := Tlen - Max_Length;
1291 Result : Bounded_Wide_String;
1292
1293 -- Tlen is the total length of the result string before any
1294 -- truncation. Blen and Alen are the lengths of the pieces
1295 -- of the original string that end up in the result string
1296 -- before and after the replaced slice.
1297
1298 begin
1299 if Droplen <= 0 then
1300 Result.Length := Tlen;
1301 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1302 Result.Data (Low .. Low + By'Length - 1) := By;
1303 Result.Data (Low + By'Length .. Tlen) :=
1304 Source.Data (High + 1 .. Slen);
1305
1306 else
1307 Result.Length := Max_Length;
1308
1309 case Drop is
1310 when Strings.Right =>
1311 Result.Data (1 .. Blen) := Source.Data (1 .. Blen);
1312
1313 if Droplen > Alen then
1314 Result.Data (Low .. Max_Length) :=
1315 By (By'First .. By'First + Max_Length - Low);
1316 else
1317 Result.Data (Low .. Low + By'Length - 1) := By;
1318 Result.Data (Low + By'Length .. Max_Length) :=
1319 Source.Data (High + 1 .. Slen - Droplen);
1320 end if;
1321
1322 when Strings.Left =>
1323 Result.Data (Max_Length - (Alen - 1) .. Max_Length) :=
1324 Source.Data (High + 1 .. Slen);
1325
1326 if Droplen >= Blen then
1327 Result.Data (1 .. Max_Length - Alen) :=
1328 By (By'Last - (Max_Length - Alen) + 1 .. By'Last);
1329 else
1330 Result.Data
1331 (Blen - Droplen + 1 .. Max_Length - Alen) := By;
1332 Result.Data (1 .. Blen - Droplen) :=
1333 Source.Data (Droplen + 1 .. Blen);
1334 end if;
1335
1336 when Strings.Error =>
1337 raise Ada.Strings.Length_Error;
1338 end case;
1339 end if;
1340
1341 return Result;
1342 end;
1343 end if;
1344 end Replace_Slice;
1345
1346 procedure Replace_Slice
1347 (Source : in out Bounded_Wide_String;
1348 Low : in Positive;
1349 High : in Natural;
1350 By : in Wide_String;
1351 Drop : in Strings.Truncation := Strings.Error)
1352 is
1353 begin
1354 -- We do a double copy here because this is one of the situations
1355 -- in which we move data to the right, and at least at the moment,
1356 -- GNAT is not handling such cases correctly ???
1357
1358 Source := Replace_Slice (Source, Low, High, By, Drop);
1359 end Replace_Slice;
1360
1361 ---------------
1362 -- Replicate --
1363 ---------------
1364
1365 function Replicate
1366 (Count : in Natural;
1367 Item : in Wide_Character;
1368 Drop : in Strings.Truncation := Strings.Error)
1369 return Bounded_Wide_String
1370 is
1371 Result : Bounded_Wide_String;
1372
1373 begin
1374 if Count <= Max_Length then
1375 Result.Length := Count;
1376
1377 elsif Drop = Strings.Error then
1378 raise Ada.Strings.Length_Error;
1379
1380 else
1381 Result.Length := Max_Length;
1382 end if;
1383
1384 Result.Data (1 .. Result.Length) := (others => Item);
1385 return Result;
1386 end Replicate;
1387
1388 function Replicate
1389 (Count : in Natural;
1390 Item : in Wide_String;
1391 Drop : in Strings.Truncation := Strings.Error)
1392 return Bounded_Wide_String
1393 is
1394 Length : constant Integer := Count * Item'Length;
1395 Result : Bounded_Wide_String;
1396 Indx : Positive;
1397
1398 begin
1399 if Length <= Max_Length then
1400 Result.Length := Length;
1401
1402 if Length > 0 then
1403 Indx := 1;
1404
1405 for J in 1 .. Count loop
1406 Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1407 Indx := Indx + Item'Length;
1408 end loop;
1409 end if;
1410
1411 else
1412 Result.Length := Max_Length;
1413
1414 case Drop is
1415 when Strings.Right =>
1416 Indx := 1;
1417
1418 while Indx + Item'Length <= Max_Length + 1 loop
1419 Result.Data (Indx .. Indx + Item'Length - 1) := Item;
1420 Indx := Indx + Item'Length;
1421 end loop;
1422
1423 Result.Data (Indx .. Max_Length) :=
1424 Item (Item'First .. Item'First + Max_Length - Indx);
1425
1426 when Strings.Left =>
1427 Indx := Max_Length;
1428
1429 while Indx - Item'Length >= 1 loop
1430 Result.Data (Indx - (Item'Length - 1) .. Indx) := Item;
1431 Indx := Indx - Item'Length;
1432 end loop;
1433
1434 Result.Data (1 .. Indx) :=
1435 Item (Item'Last - Indx + 1 .. Item'Last);
1436
1437 when Strings.Error =>
1438 raise Ada.Strings.Length_Error;
1439 end case;
1440 end if;
1441
1442 return Result;
1443 end Replicate;
1444
1445 function Replicate
1446 (Count : in Natural;
1447 Item : in Bounded_Wide_String;
1448 Drop : in Strings.Truncation := Strings.Error)
1449 return Bounded_Wide_String
1450 is
1451 begin
1452 return Replicate (Count, Item.Data (1 .. Item.Length), Drop);
1453 end Replicate;
1454
1455 -----------
1456 -- Slice --
1457 -----------
1458
1459 function Slice
1460 (Source : Bounded_Wide_String;
1461 Low : Positive;
1462 High : Natural)
1463 return Wide_String
1464 is
1465 begin
1466 -- Note: test of High > Length is in accordance with AI95-00128
1467
1468 if Low > Source.Length + 1 or else High > Source.Length then
1469 raise Index_Error;
1470
1471 else
1472 declare
1473 Result : Wide_String (1 .. High - Low + 1);
1474
1475 begin
1476 Result := Source.Data (Low .. High);
1477 return Result;
1478 end;
1479 end if;
1480 end Slice;
1481
1482 ----------
1483 -- Tail --
1484 ----------
1485
1486 function Tail
1487 (Source : in Bounded_Wide_String;
1488 Count : in Natural;
1489 Pad : in Wide_Character := Wide_Space;
1490 Drop : in Strings.Truncation := Strings.Error)
1491 return Bounded_Wide_String
1492 is
1493 Result : Bounded_Wide_String;
1494 Slen : constant Natural := Source.Length;
1495 Npad : constant Integer := Count - Slen;
1496
1497 begin
1498 if Npad <= 0 then
1499 Result.Length := Count;
1500 Result.Data (1 .. Count) :=
1501 Source.Data (Slen - (Count - 1) .. Slen);
1502
1503 elsif Count <= Max_Length then
1504 Result.Length := Count;
1505 Result.Data (1 .. Npad) := (others => Pad);
1506 Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen);
1507
1508 else
1509 Result.Length := Max_Length;
1510
1511 case Drop is
1512 when Strings.Right =>
1513 if Npad >= Max_Length then
1514 Result.Data := (others => Pad);
1515
1516 else
1517 Result.Data (1 .. Npad) := (others => Pad);
1518 Result.Data (Npad + 1 .. Max_Length) :=
1519 Source.Data (1 .. Max_Length - Npad);
1520 end if;
1521
1522 when Strings.Left =>
1523 Result.Data (1 .. Max_Length - Slen) := (others => Pad);
1524 Result.Data (Max_Length - Slen + 1 .. Max_Length) :=
1525 Source.Data (1 .. Slen);
1526
1527 when Strings.Error =>
1528 raise Ada.Strings.Length_Error;
1529 end case;
1530 end if;
1531
1532 return Result;
1533 end Tail;
1534
1535 procedure Tail
1536 (Source : in out Bounded_Wide_String;
1537 Count : in Natural;
1538 Pad : in Wide_Character := Wide_Space;
1539 Drop : in Truncation := Error)
1540 is
1541 Slen : constant Natural := Source.Length;
1542 Npad : constant Integer := Count - Slen;
1543 Temp : Wide_String (1 .. Max_Length) := Source.Data;
1544
1545 begin
1546 if Npad <= 0 then
1547 Source.Length := Count;
1548 Source.Data (1 .. Count) :=
1549 Temp (Slen - (Count - 1) .. Slen);
1550
1551 elsif Count <= Max_Length then
1552 Source.Length := Count;
1553 Source.Data (1 .. Npad) := (others => Pad);
1554 Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen);
1555
1556 else
1557 Source.Length := Max_Length;
1558
1559 case Drop is
1560 when Strings.Right =>
1561 if Npad >= Max_Length then
1562 Source.Data := (others => Pad);
1563
1564 else
1565 Source.Data (1 .. Npad) := (others => Pad);
1566 Source.Data (Npad + 1 .. Max_Length) :=
1567 Temp (1 .. Max_Length - Npad);
1568 end if;
1569
1570 when Strings.Left =>
1571 for J in 1 .. Max_Length - Slen loop
1572 Source.Data (J) := Pad;
1573 end loop;
1574
1575 Source.Data (Max_Length - Slen + 1 .. Max_Length) :=
1576 Temp (1 .. Slen);
1577
1578 when Strings.Error =>
1579 raise Ada.Strings.Length_Error;
1580 end case;
1581 end if;
1582
1583 end Tail;
1584
1585 ----------------------------
1586 -- To_Bounded_Wide_String --
1587 ----------------------------
1588
1589 function To_Bounded_Wide_String
1590 (Source : in Wide_String;
1591 Drop : in Strings.Truncation := Strings.Error)
1592 return Bounded_Wide_String
1593 is
1594 Slen : constant Natural := Source'Length;
1595 Result : Bounded_Wide_String;
1596
1597 begin
1598 if Slen <= Max_Length then
1599 Result.Length := Slen;
1600 Result.Data (1 .. Slen) := Source;
1601
1602 else
1603 case Drop is
1604 when Strings.Right =>
1605 Result.Length := Max_Length;
1606 Result.Data (1 .. Max_Length) :=
1607 Source (Source'First .. Source'First - 1 + Max_Length);
1608
1609 when Strings.Left =>
1610 Result.Length := Max_Length;
1611 Result.Data (1 .. Max_Length) :=
1612 Source (Source'Last - (Max_Length - 1) .. Source'Last);
1613
1614 when Strings.Error =>
1615 raise Ada.Strings.Length_Error;
1616 end case;
1617 end if;
1618
1619 return Result;
1620 end To_Bounded_Wide_String;
1621
1622 --------------------
1623 -- To_Wide_String --
1624 --------------------
1625
1626 function To_Wide_String
1627 (Source : in Bounded_Wide_String)
1628 return Wide_String
1629 is
1630 begin
1631 return Source.Data (1 .. Source.Length);
1632 end To_Wide_String;
1633
1634 ---------------
1635 -- Translate --
1636 ---------------
1637
1638 function Translate
1639 (Source : in Bounded_Wide_String;
1640 Mapping : in Wide_Maps.Wide_Character_Mapping)
1641 return Bounded_Wide_String
1642 is
1643 Result : Bounded_Wide_String;
1644
1645 begin
1646 Result.Length := Source.Length;
1647
1648 for J in 1 .. Source.Length loop
1649 Result.Data (J) := Value (Mapping, Source.Data (J));
1650 end loop;
1651
1652 return Result;
1653 end Translate;
1654
1655 procedure Translate
1656 (Source : in out Bounded_Wide_String;
1657 Mapping : in Wide_Maps.Wide_Character_Mapping)
1658 is
1659 begin
1660 for J in 1 .. Source.Length loop
1661 Source.Data (J) := Value (Mapping, Source.Data (J));
1662 end loop;
1663 end Translate;
1664
1665 function Translate
1666 (Source : in Bounded_Wide_String;
1667 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
1668 return Bounded_Wide_String
1669 is
1670 Result : Bounded_Wide_String;
1671
1672 begin
1673 Result.Length := Source.Length;
1674
1675 for J in 1 .. Source.Length loop
1676 Result.Data (J) := Mapping.all (Source.Data (J));
1677 end loop;
1678
1679 return Result;
1680 end Translate;
1681
1682 procedure Translate
1683 (Source : in out Bounded_Wide_String;
1684 Mapping : in Wide_Maps.Wide_Character_Mapping_Function)
1685 is
1686 begin
1687 for J in 1 .. Source.Length loop
1688 Source.Data (J) := Mapping.all (Source.Data (J));
1689 end loop;
1690 end Translate;
1691
1692 ----------
1693 -- Trim --
1694 ----------
1695
1696 function Trim
1697 (Source : in Bounded_Wide_String;
1698 Side : in Trim_End)
1699 return Bounded_Wide_String
1700 is
1701 Result : Bounded_Wide_String;
1702 Last : Natural := Source.Length;
1703 First : Positive := 1;
1704
1705 begin
1706 if Side = Left or else Side = Both then
1707 while First <= Last and then Source.Data (First) = ' ' loop
1708 First := First + 1;
1709 end loop;
1710 end if;
1711
1712 if Side = Right or else Side = Both then
1713 while Last >= First and then Source.Data (Last) = ' ' loop
1714 Last := Last - 1;
1715 end loop;
1716 end if;
1717
1718 Result.Length := Last - First + 1;
1719 Result.Data (1 .. Result.Length) := Source.Data (First .. Last);
1720 return Result;
1721
1722 end Trim;
1723
1724 procedure Trim
1725 (Source : in out Bounded_Wide_String;
1726 Side : in Trim_End)
1727 is
1728 Last : Length_Range := Source.Length;
1729 First : Positive := 1;
1730 Temp : Wide_String (1 .. Max_Length);
1731
1732 begin
1733 Temp (1 .. Last) := Source.Data (1 .. Last);
1734
1735 if Side = Left or else Side = Both then
1736 while First <= Last and then Temp (First) = ' ' loop
1737 First := First + 1;
1738 end loop;
1739 end if;
1740
1741 if Side = Right or else Side = Both then
1742 while Last >= First and then Temp (Last) = ' ' loop
1743 Last := Last - 1;
1744 end loop;
1745 end if;
1746
1747 Source.Length := Last - First + 1;
1748 Source.Data (1 .. Source.Length) := Temp (First .. Last);
1749
1750 end Trim;
1751
1752 function Trim
1753 (Source : in Bounded_Wide_String;
1754 Left : in Wide_Maps.Wide_Character_Set;
1755 Right : in Wide_Maps.Wide_Character_Set)
1756 return Bounded_Wide_String
1757 is
1758 Result : Bounded_Wide_String;
1759
1760 begin
1761 for First in 1 .. Source.Length loop
1762 if not Is_In (Source.Data (First), Left) then
1763 for Last in reverse First .. Source.Length loop
1764 if not Is_In (Source.Data (Last), Right) then
1765 Result.Length := Last - First + 1;
1766 Result.Data (1 .. Result.Length) :=
1767 Source.Data (First .. Last);
1768 return Result;
1769 end if;
1770 end loop;
1771 end if;
1772 end loop;
1773
1774 Result.Length := 0;
1775 return Result;
1776 end Trim;
1777
1778 procedure Trim
1779 (Source : in out Bounded_Wide_String;
1780 Left : in Wide_Maps.Wide_Character_Set;
1781 Right : in Wide_Maps.Wide_Character_Set)
1782 is
1783 begin
1784 for First in 1 .. Source.Length loop
1785 if not Is_In (Source.Data (First), Left) then
1786 for Last in reverse First .. Source.Length loop
1787 if not Is_In (Source.Data (Last), Right) then
1788 if First = 1 then
1789 Source.Length := Last;
1790 return;
1791 else
1792 Source.Length := Last - First + 1;
1793 Source.Data (1 .. Source.Length) :=
1794 Source.Data (First .. Last);
1795 return;
1796 end if;
1797 end if;
1798 end loop;
1799
1800 Source.Length := 0;
1801 return;
1802 end if;
1803 end loop;
1804
1805 Source.Length := 0;
1806 end Trim;
1807
1808 end Generic_Bounded_Length;
1809
1810 end Ada.Strings.Wide_Bounded;
Mirror of the offical gcc git repository hosted at gcc.gnu.org