config/sparc/sol2-bi.h: Revert previous delta.
[official-gcc.git] / gcc / ada / a-strunb.adb
blob4cf7e484efb37c2d311f8b9c0eed59328310baef
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . U N 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 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 -- --
33 ------------------------------------------------------------------------------
35 with Ada.Strings.Fixed;
36 with Ada.Strings.Search;
37 with Ada.Unchecked_Deallocation;
39 package body Ada.Strings.Unbounded is
41 use Ada.Finalization;
43 ---------
44 -- "&" --
45 ---------
47 function "&" (Left, Right : Unbounded_String) return Unbounded_String is
48 L_Length : constant Integer := Left.Reference.all'Length;
49 R_Length : constant Integer := Right.Reference.all'Length;
50 Length : constant Integer := L_Length + R_Length;
51 Result : Unbounded_String;
53 begin
54 Result.Reference := new String (1 .. Length);
55 Result.Reference.all (1 .. L_Length) := Left.Reference.all;
56 Result.Reference.all (L_Length + 1 .. Length) := Right.Reference.all;
57 return Result;
58 end "&";
60 function "&"
61 (Left : Unbounded_String;
62 Right : String)
63 return Unbounded_String
65 L_Length : constant Integer := Left.Reference.all'Length;
66 Length : constant Integer := L_Length + Right'Length;
67 Result : Unbounded_String;
69 begin
70 Result.Reference := new String (1 .. Length);
71 Result.Reference.all (1 .. L_Length) := Left.Reference.all;
72 Result.Reference.all (L_Length + 1 .. Length) := Right;
73 return Result;
74 end "&";
76 function "&"
77 (Left : String;
78 Right : Unbounded_String)
79 return Unbounded_String
81 R_Length : constant Integer := Right.Reference.all'Length;
82 Length : constant Integer := Left'Length + R_Length;
83 Result : Unbounded_String;
85 begin
86 Result.Reference := new String (1 .. Length);
87 Result.Reference.all (1 .. Left'Length) := Left;
88 Result.Reference.all (Left'Length + 1 .. Length) := Right.Reference.all;
89 return Result;
90 end "&";
92 function "&"
93 (Left : Unbounded_String;
94 Right : Character)
95 return Unbounded_String
97 Length : constant Integer := Left.Reference.all'Length + 1;
98 Result : Unbounded_String;
100 begin
101 Result.Reference := new String (1 .. Length);
102 Result.Reference.all (1 .. Length - 1) := Left.Reference.all;
103 Result.Reference.all (Length) := Right;
104 return Result;
105 end "&";
107 function "&"
108 (Left : Character;
109 Right : Unbounded_String)
110 return Unbounded_String
112 Length : constant Integer := Right.Reference.all'Length + 1;
113 Result : Unbounded_String;
115 begin
116 Result.Reference := new String (1 .. Length);
117 Result.Reference.all (1) := Left;
118 Result.Reference.all (2 .. Length) := Right.Reference.all;
119 return Result;
120 end "&";
122 ---------
123 -- "*" --
124 ---------
126 function "*"
127 (Left : Natural;
128 Right : Character)
129 return Unbounded_String
131 Result : Unbounded_String;
133 begin
134 Result.Reference := new String (1 .. Left);
135 for J in Result.Reference'Range loop
136 Result.Reference (J) := Right;
137 end loop;
139 return Result;
140 end "*";
142 function "*"
143 (Left : Natural;
144 Right : String)
145 return Unbounded_String
147 Len : constant Integer := Right'Length;
148 Result : Unbounded_String;
150 begin
151 Result.Reference := new String (1 .. Left * Len);
152 for J in 1 .. Left loop
153 Result.Reference.all (Len * J - Len + 1 .. Len * J) := Right;
154 end loop;
156 return Result;
157 end "*";
159 function "*"
160 (Left : Natural;
161 Right : Unbounded_String)
162 return Unbounded_String
164 Len : constant Integer := Right.Reference.all'Length;
165 Result : Unbounded_String;
167 begin
168 Result.Reference := new String (1 .. Left * Len);
169 for I in 1 .. Left loop
170 Result.Reference.all (Len * I - Len + 1 .. Len * I) :=
171 Right.Reference.all;
172 end loop;
174 return Result;
175 end "*";
177 ---------
178 -- "<" --
179 ---------
181 function "<" (Left, Right : in Unbounded_String) return Boolean is
182 begin
183 return Left.Reference.all < Right.Reference.all;
184 end "<";
186 function "<"
187 (Left : in Unbounded_String;
188 Right : in String)
189 return Boolean
191 begin
192 return Left.Reference.all < Right;
193 end "<";
195 function "<"
196 (Left : in String;
197 Right : in Unbounded_String)
198 return Boolean
200 begin
201 return Left < Right.Reference.all;
202 end "<";
204 ----------
205 -- "<=" --
206 ----------
208 function "<=" (Left, Right : in Unbounded_String) return Boolean is
209 begin
210 return Left.Reference.all <= Right.Reference.all;
211 end "<=";
213 function "<="
214 (Left : in Unbounded_String;
215 Right : in String)
216 return Boolean
218 begin
219 return Left.Reference.all <= Right;
220 end "<=";
222 function "<="
223 (Left : in String;
224 Right : in Unbounded_String)
225 return Boolean
227 begin
228 return Left <= Right.Reference.all;
229 end "<=";
231 ---------
232 -- "=" --
233 ---------
235 function "=" (Left, Right : in Unbounded_String) return Boolean is
236 begin
237 return Left.Reference.all = Right.Reference.all;
238 end "=";
240 function "="
241 (Left : in Unbounded_String;
242 Right : in String)
243 return Boolean
245 begin
246 return Left.Reference.all = Right;
247 end "=";
249 function "="
250 (Left : in String;
251 Right : in Unbounded_String)
252 return Boolean
254 begin
255 return Left = Right.Reference.all;
256 end "=";
258 ---------
259 -- ">" --
260 ---------
262 function ">" (Left, Right : in Unbounded_String) return Boolean is
263 begin
264 return Left.Reference.all > Right.Reference.all;
265 end ">";
267 function ">"
268 (Left : in Unbounded_String;
269 Right : in String)
270 return Boolean
272 begin
273 return Left.Reference.all > Right;
274 end ">";
276 function ">"
277 (Left : in String;
278 Right : in Unbounded_String)
279 return Boolean
281 begin
282 return Left > Right.Reference.all;
283 end ">";
285 ----------
286 -- ">=" --
287 ----------
289 function ">=" (Left, Right : in Unbounded_String) return Boolean is
290 begin
291 return Left.Reference.all >= Right.Reference.all;
292 end ">=";
294 function ">="
295 (Left : in Unbounded_String;
296 Right : in String)
297 return Boolean
299 begin
300 return Left.Reference.all >= Right;
301 end ">=";
303 function ">="
304 (Left : in String;
305 Right : in Unbounded_String)
306 return Boolean
308 begin
309 return Left >= Right.Reference.all;
310 end ">=";
312 ------------
313 -- Adjust --
314 ------------
316 procedure Adjust (Object : in out Unbounded_String) is
317 begin
318 -- Copy string, except we do not copy the statically allocated null
319 -- string, since it can never be deallocated.
321 if Object.Reference /= Null_String'Access then
322 Object.Reference := new String'(Object.Reference.all);
323 end if;
324 end Adjust;
326 ------------
327 -- Append --
328 ------------
330 procedure Append
331 (Source : in out Unbounded_String;
332 New_Item : in Unbounded_String)
334 S_Length : constant Integer := Source.Reference.all'Length;
335 Length : constant Integer := S_Length + New_Item.Reference.all'Length;
336 Tmp : String_Access;
338 begin
339 Tmp := new String (1 .. Length);
340 Tmp (1 .. S_Length) := Source.Reference.all;
341 Tmp (S_Length + 1 .. Length) := New_Item.Reference.all;
342 Free (Source.Reference);
343 Source.Reference := Tmp;
344 end Append;
346 procedure Append
347 (Source : in out Unbounded_String;
348 New_Item : in String)
350 S_Length : constant Integer := Source.Reference.all'Length;
351 Length : constant Integer := S_Length + New_Item'Length;
352 Tmp : String_Access;
354 begin
355 Tmp := new String (1 .. Length);
356 Tmp (1 .. S_Length) := Source.Reference.all;
357 Tmp (S_Length + 1 .. Length) := New_Item;
358 Free (Source.Reference);
359 Source.Reference := Tmp;
360 end Append;
362 procedure Append
363 (Source : in out Unbounded_String;
364 New_Item : in Character)
366 S_Length : constant Integer := Source.Reference.all'Length;
367 Length : constant Integer := S_Length + 1;
368 Tmp : String_Access;
370 begin
371 Tmp := new String (1 .. Length);
372 Tmp (1 .. S_Length) := Source.Reference.all;
373 Tmp (S_Length + 1) := New_Item;
374 Free (Source.Reference);
375 Source.Reference := Tmp;
376 end Append;
378 -----------
379 -- Count --
380 -----------
382 function Count
383 (Source : Unbounded_String;
384 Pattern : String;
385 Mapping : Maps.Character_Mapping := Maps.Identity)
386 return Natural
388 begin
389 return Search.Count (Source.Reference.all, Pattern, Mapping);
390 end Count;
392 function Count
393 (Source : in Unbounded_String;
394 Pattern : in String;
395 Mapping : in Maps.Character_Mapping_Function)
396 return Natural
398 begin
399 return Search.Count (Source.Reference.all, Pattern, Mapping);
400 end Count;
402 function Count
403 (Source : Unbounded_String;
404 Set : Maps.Character_Set)
405 return Natural
407 begin
408 return Search.Count (Source.Reference.all, Set);
409 end Count;
411 ------------
412 -- Delete --
413 ------------
415 function Delete
416 (Source : Unbounded_String;
417 From : Positive;
418 Through : Natural)
419 return Unbounded_String
421 begin
422 return
423 To_Unbounded_String
424 (Fixed.Delete (Source.Reference.all, From, Through));
425 end Delete;
427 procedure Delete
428 (Source : in out Unbounded_String;
429 From : in Positive;
430 Through : in Natural)
432 Old : String_Access := Source.Reference;
434 begin
435 Source.Reference :=
436 new String' (Fixed.Delete (Old.all, From, Through));
437 Free (Old);
438 end Delete;
440 -------------
441 -- Element --
442 -------------
444 function Element
445 (Source : Unbounded_String;
446 Index : Positive)
447 return Character
449 begin
450 if Index <= Source.Reference.all'Last then
451 return Source.Reference.all (Index);
452 else
453 raise Strings.Index_Error;
454 end if;
455 end Element;
457 --------------
458 -- Finalize --
459 --------------
461 procedure Finalize (Object : in out Unbounded_String) is
462 procedure Deallocate is
463 new Ada.Unchecked_Deallocation (String, String_Access);
465 begin
466 -- Note: Don't try to free statically allocated null string
468 if Object.Reference /= Null_String'Access then
469 Deallocate (Object.Reference);
470 Object.Reference := Null_Unbounded_String.Reference;
471 end if;
472 end Finalize;
474 ----------------
475 -- Find_Token --
476 ----------------
478 procedure Find_Token
479 (Source : Unbounded_String;
480 Set : Maps.Character_Set;
481 Test : Strings.Membership;
482 First : out Positive;
483 Last : out Natural)
485 begin
486 Search.Find_Token (Source.Reference.all, Set, Test, First, Last);
487 end Find_Token;
489 ----------
490 -- Free --
491 ----------
493 procedure Free (X : in out String_Access) is
494 procedure Deallocate is
495 new Ada.Unchecked_Deallocation (String, String_Access);
497 begin
498 -- Note: Don't try to free statically allocated null string
500 if X /= Null_Unbounded_String.Reference then
501 Deallocate (X);
502 end if;
503 end Free;
505 ----------
506 -- Head --
507 ----------
509 function Head
510 (Source : Unbounded_String;
511 Count : Natural;
512 Pad : Character := Space)
513 return Unbounded_String
515 begin
516 return
517 To_Unbounded_String (Fixed.Head (Source.Reference.all, Count, Pad));
518 end Head;
520 procedure Head
521 (Source : in out Unbounded_String;
522 Count : in Natural;
523 Pad : in Character := Space)
525 Old : String_Access := Source.Reference;
527 begin
528 Source.Reference := new String'(Fixed.Head (Old.all, Count, Pad));
529 Free (Old);
530 end Head;
532 -----------
533 -- Index --
534 -----------
536 function Index
537 (Source : Unbounded_String;
538 Pattern : String;
539 Going : Strings.Direction := Strings.Forward;
540 Mapping : Maps.Character_Mapping := Maps.Identity)
541 return Natural
543 begin
544 return Search.Index (Source.Reference.all, Pattern, Going, Mapping);
545 end Index;
547 function Index
548 (Source : in Unbounded_String;
549 Pattern : in String;
550 Going : in Direction := Forward;
551 Mapping : in Maps.Character_Mapping_Function)
552 return Natural
554 begin
555 return Search.Index (Source.Reference.all, Pattern, Going, Mapping);
556 end Index;
558 function Index
559 (Source : Unbounded_String;
560 Set : Maps.Character_Set;
561 Test : Strings.Membership := Strings.Inside;
562 Going : Strings.Direction := Strings.Forward)
563 return Natural
565 begin
566 return Search.Index (Source.Reference.all, Set, Test, Going);
567 end Index;
569 function Index_Non_Blank
570 (Source : Unbounded_String;
571 Going : Strings.Direction := Strings.Forward)
572 return Natural
574 begin
575 return Search.Index_Non_Blank (Source.Reference.all, Going);
576 end Index_Non_Blank;
578 ----------------
579 -- Initialize --
580 ----------------
582 procedure Initialize (Object : in out Unbounded_String) is
583 begin
584 Object.Reference := Null_Unbounded_String.Reference;
585 end Initialize;
587 ------------
588 -- Insert --
589 ------------
591 function Insert
592 (Source : Unbounded_String;
593 Before : Positive;
594 New_Item : String)
595 return Unbounded_String
597 begin
598 return
599 To_Unbounded_String
600 (Fixed.Insert (Source.Reference.all, Before, New_Item));
601 end Insert;
603 procedure Insert
604 (Source : in out Unbounded_String;
605 Before : in Positive;
606 New_Item : in String)
608 Old : String_Access := Source.Reference;
610 begin
611 Source.Reference :=
612 new String' (Fixed.Insert (Source.Reference.all, Before, New_Item));
613 Free (Old);
614 end Insert;
616 ------------
617 -- Length --
618 ------------
620 function Length (Source : Unbounded_String) return Natural is
621 begin
622 return Source.Reference.all'Length;
623 end Length;
625 ---------------
626 -- Overwrite --
627 ---------------
629 function Overwrite
630 (Source : Unbounded_String;
631 Position : Positive;
632 New_Item : String)
633 return Unbounded_String is
635 begin
636 return To_Unbounded_String
637 (Fixed.Overwrite (Source.Reference.all, Position, New_Item));
638 end Overwrite;
640 procedure Overwrite
641 (Source : in out Unbounded_String;
642 Position : in Positive;
643 New_Item : in String)
645 NL : constant Integer := New_Item'Length;
647 begin
648 if Position <= Source.Reference'Length - NL + 1 then
649 Source.Reference (Position .. Position + NL - 1) := New_Item;
651 else
652 declare
653 Old : String_Access := Source.Reference;
655 begin
656 Source.Reference := new
657 String'(Fixed.Overwrite (Old.all, Position, New_Item));
658 Free (Old);
659 end;
660 end if;
661 end Overwrite;
663 ---------------------
664 -- Replace_Element --
665 ---------------------
667 procedure Replace_Element
668 (Source : in out Unbounded_String;
669 Index : Positive;
670 By : Character)
672 begin
673 if Index <= Source.Reference.all'Last then
674 Source.Reference.all (Index) := By;
675 else
676 raise Strings.Index_Error;
677 end if;
678 end Replace_Element;
680 -------------------
681 -- Replace_Slice --
682 -------------------
684 function Replace_Slice
685 (Source : Unbounded_String;
686 Low : Positive;
687 High : Natural;
688 By : String)
689 return Unbounded_String
691 begin
692 return
693 To_Unbounded_String
694 (Fixed.Replace_Slice (Source.Reference.all, Low, High, By));
695 end Replace_Slice;
697 procedure Replace_Slice
698 (Source : in out Unbounded_String;
699 Low : in Positive;
700 High : in Natural;
701 By : in String)
703 Old : String_Access := Source.Reference;
705 begin
706 Source.Reference :=
707 new String'(Fixed.Replace_Slice (Old.all, Low, High, By));
708 Free (Old);
709 end Replace_Slice;
711 -----------
712 -- Slice --
713 -----------
715 function Slice
716 (Source : Unbounded_String;
717 Low : Positive;
718 High : Natural)
719 return String
721 Length : constant Natural := Source.Reference'Length;
723 begin
724 -- Note: test of High > Length is in accordance with AI95-00128
726 if Low > Length + 1 or else High > Length then
727 raise Index_Error;
728 else
729 return Source.Reference.all (Low .. High);
730 end if;
731 end Slice;
733 ----------
734 -- Tail --
735 ----------
737 function Tail
738 (Source : Unbounded_String;
739 Count : Natural;
740 Pad : Character := Space)
741 return Unbounded_String is
743 begin
744 return
745 To_Unbounded_String (Fixed.Tail (Source.Reference.all, Count, Pad));
746 end Tail;
748 procedure Tail
749 (Source : in out Unbounded_String;
750 Count : in Natural;
751 Pad : in Character := Space)
753 Old : String_Access := Source.Reference;
755 begin
756 Source.Reference := new String'(Fixed.Tail (Old.all, Count, Pad));
757 Free (Old);
758 end Tail;
760 ---------------
761 -- To_String --
762 ---------------
764 function To_String (Source : Unbounded_String) return String is
765 begin
766 return Source.Reference.all;
767 end To_String;
769 -------------------------
770 -- To_Unbounded_String --
771 -------------------------
773 function To_Unbounded_String (Source : String) return Unbounded_String is
774 Result : Unbounded_String;
776 begin
777 Result.Reference := new String (1 .. Source'Length);
778 Result.Reference.all := Source;
779 return Result;
780 end To_Unbounded_String;
782 function To_Unbounded_String
783 (Length : in Natural)
784 return Unbounded_String
786 Result : Unbounded_String;
788 begin
789 Result.Reference := new String (1 .. Length);
790 return Result;
791 end To_Unbounded_String;
793 ---------------
794 -- Translate --
795 ---------------
797 function Translate
798 (Source : Unbounded_String;
799 Mapping : Maps.Character_Mapping)
800 return Unbounded_String
802 begin
803 return
804 To_Unbounded_String (Fixed.Translate (Source.Reference.all, Mapping));
805 end Translate;
807 procedure Translate
808 (Source : in out Unbounded_String;
809 Mapping : Maps.Character_Mapping)
811 begin
812 Fixed.Translate (Source.Reference.all, Mapping);
813 end Translate;
815 function Translate
816 (Source : in Unbounded_String;
817 Mapping : in Maps.Character_Mapping_Function)
818 return Unbounded_String
820 begin
821 return
822 To_Unbounded_String (Fixed.Translate (Source.Reference.all, Mapping));
823 end Translate;
825 procedure Translate
826 (Source : in out Unbounded_String;
827 Mapping : in Maps.Character_Mapping_Function)
829 begin
830 Fixed.Translate (Source.Reference.all, Mapping);
831 end Translate;
833 ----------
834 -- Trim --
835 ----------
837 function Trim
838 (Source : in Unbounded_String;
839 Side : in Trim_End)
840 return Unbounded_String
842 begin
843 return To_Unbounded_String (Fixed.Trim (Source.Reference.all, Side));
844 end Trim;
846 procedure Trim
847 (Source : in out Unbounded_String;
848 Side : in Trim_End)
850 Old : String_Access := Source.Reference;
852 begin
853 Source.Reference := new String'(Fixed.Trim (Old.all, Side));
854 Free (Old);
855 end Trim;
857 function Trim
858 (Source : in Unbounded_String;
859 Left : in Maps.Character_Set;
860 Right : in Maps.Character_Set)
861 return Unbounded_String
863 begin
864 return
865 To_Unbounded_String (Fixed.Trim (Source.Reference.all, Left, Right));
866 end Trim;
868 procedure Trim
869 (Source : in out Unbounded_String;
870 Left : in Maps.Character_Set;
871 Right : in Maps.Character_Set)
873 Old : String_Access := Source.Reference;
875 begin
876 Source.Reference := new String'(Fixed.Trim (Old.all, Left, Right));
877 Free (Old);
878 end Trim;
880 end Ada.Strings.Unbounded;