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