Mark ChangeLog
[official-gcc.git] / gcc / ada / a-strfix.adb
blobaadc977051c9c769d4fbc5248803c1da2cb87f63
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . F I X E D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 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 ------------------------------------------------------------------------------
34 -- Note: This code is derived from the ADAR.CSH public domain Ada 83
35 -- versions of the Appendix C string handling packages. One change is
36 -- to avoid the use of Is_In, so that we are not dependent on inlining.
37 -- Note that the search function implementations are to be found in the
38 -- auxiliary package Ada.Strings.Search. Also the Move procedure is
39 -- directly incorporated (ADAR used a subunit for this procedure). A
40 -- number of errors having to do with bounds of function return results
41 -- were also fixed, and use of & removed for efficiency reasons.
43 with Ada.Strings.Maps; use Ada.Strings.Maps;
44 with Ada.Strings.Search;
46 package body Ada.Strings.Fixed is
48 ------------------------
49 -- Search Subprograms --
50 ------------------------
52 function Index
53 (Source : String;
54 Pattern : String;
55 Going : Direction := Forward;
56 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
57 renames Ada.Strings.Search.Index;
59 function Index
60 (Source : String;
61 Pattern : String;
62 Going : Direction := Forward;
63 Mapping : Maps.Character_Mapping_Function) return Natural
64 renames Ada.Strings.Search.Index;
66 function Index
67 (Source : String;
68 Set : Maps.Character_Set;
69 Test : Membership := Inside;
70 Going : Direction := Forward) return Natural
71 renames Ada.Strings.Search.Index;
73 function Index
74 (Source : String;
75 Pattern : String;
76 From : Positive;
77 Going : Direction := Forward;
78 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
79 renames Ada.Strings.Search.Index;
81 function Index
82 (Source : String;
83 Pattern : String;
84 From : Positive;
85 Going : Direction := Forward;
86 Mapping : Maps.Character_Mapping_Function) return Natural
87 renames Ada.Strings.Search.Index;
89 function Index
90 (Source : String;
91 Set : Maps.Character_Set;
92 From : Positive;
93 Test : Membership := Inside;
94 Going : Direction := Forward) return Natural
95 renames Ada.Strings.Search.Index;
97 function Index_Non_Blank
98 (Source : String;
99 Going : Direction := Forward) return Natural
100 renames Ada.Strings.Search.Index_Non_Blank;
102 function Index_Non_Blank
103 (Source : String;
104 From : Positive;
105 Going : Direction := Forward) return Natural
106 renames Ada.Strings.Search.Index_Non_Blank;
108 function Count
109 (Source : String;
110 Pattern : String;
111 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
112 renames Ada.Strings.Search.Count;
114 function Count
115 (Source : String;
116 Pattern : String;
117 Mapping : Maps.Character_Mapping_Function) return Natural
118 renames Ada.Strings.Search.Count;
120 function Count
121 (Source : String;
122 Set : Maps.Character_Set) return Natural
123 renames Ada.Strings.Search.Count;
125 procedure Find_Token
126 (Source : String;
127 Set : Maps.Character_Set;
128 Test : Membership;
129 First : out Positive;
130 Last : out Natural)
131 renames Ada.Strings.Search.Find_Token;
133 ---------
134 -- "*" --
135 ---------
137 function "*"
138 (Left : Natural;
139 Right : Character) return String
141 Result : String (1 .. Left);
143 begin
144 for J in Result'Range loop
145 Result (J) := Right;
146 end loop;
148 return Result;
149 end "*";
151 function "*"
152 (Left : Natural;
153 Right : String) return String
155 Result : String (1 .. Left * Right'Length);
156 Ptr : Integer := 1;
158 begin
159 for J in 1 .. Left loop
160 Result (Ptr .. Ptr + Right'Length - 1) := Right;
161 Ptr := Ptr + Right'Length;
162 end loop;
164 return Result;
165 end "*";
167 ------------
168 -- Delete --
169 ------------
171 function Delete
172 (Source : String;
173 From : Positive;
174 Through : Natural) return String
176 begin
177 if From > Through then
178 declare
179 subtype Result_Type is String (1 .. Source'Length);
181 begin
182 return Result_Type (Source);
183 end;
185 elsif From not in Source'Range
186 or else Through > Source'Last
187 then
188 raise Index_Error;
190 else
191 declare
192 Front : constant Integer := From - Source'First;
193 Result : String (1 .. Source'Length - (Through - From + 1));
195 begin
196 Result (1 .. Front) :=
197 Source (Source'First .. From - 1);
198 Result (Front + 1 .. Result'Last) :=
199 Source (Through + 1 .. Source'Last);
201 return Result;
202 end;
203 end if;
204 end Delete;
206 procedure Delete
207 (Source : in out String;
208 From : Positive;
209 Through : Natural;
210 Justify : Alignment := Left;
211 Pad : Character := Space)
213 begin
214 Move (Source => Delete (Source, From, Through),
215 Target => Source,
216 Justify => Justify,
217 Pad => Pad);
218 end Delete;
220 ----------
221 -- Head --
222 ----------
224 function Head
225 (Source : String;
226 Count : Natural;
227 Pad : Character := Space) return String
229 subtype Result_Type is String (1 .. Count);
231 begin
232 if Count < Source'Length then
233 return
234 Result_Type (Source (Source'First .. Source'First + Count - 1));
236 else
237 declare
238 Result : Result_Type;
240 begin
241 Result (1 .. Source'Length) := Source;
243 for J in Source'Length + 1 .. Count loop
244 Result (J) := Pad;
245 end loop;
247 return Result;
248 end;
249 end if;
250 end Head;
252 procedure Head
253 (Source : in out String;
254 Count : Natural;
255 Justify : Alignment := Left;
256 Pad : Character := Space)
258 begin
259 Move (Source => Head (Source, Count, Pad),
260 Target => Source,
261 Drop => Error,
262 Justify => Justify,
263 Pad => Pad);
264 end Head;
266 ------------
267 -- Insert --
268 ------------
270 function Insert
271 (Source : String;
272 Before : Positive;
273 New_Item : String) return String
275 Result : String (1 .. Source'Length + New_Item'Length);
276 Front : constant Integer := Before - Source'First;
278 begin
279 if Before not in Source'First .. Source'Last + 1 then
280 raise Index_Error;
281 end if;
283 Result (1 .. Front) :=
284 Source (Source'First .. Before - 1);
285 Result (Front + 1 .. Front + New_Item'Length) :=
286 New_Item;
287 Result (Front + New_Item'Length + 1 .. Result'Last) :=
288 Source (Before .. Source'Last);
290 return Result;
291 end Insert;
293 procedure Insert
294 (Source : in out String;
295 Before : Positive;
296 New_Item : String;
297 Drop : Truncation := Error)
299 begin
300 Move (Source => Insert (Source, Before, New_Item),
301 Target => Source,
302 Drop => Drop);
303 end Insert;
305 ----------
306 -- Move --
307 ----------
309 procedure Move
310 (Source : String;
311 Target : out String;
312 Drop : Truncation := Error;
313 Justify : Alignment := Left;
314 Pad : Character := Space)
316 Sfirst : constant Integer := Source'First;
317 Slast : constant Integer := Source'Last;
318 Slength : constant Integer := Source'Length;
320 Tfirst : constant Integer := Target'First;
321 Tlast : constant Integer := Target'Last;
322 Tlength : constant Integer := Target'Length;
324 function Is_Padding (Item : String) return Boolean;
325 -- Check if Item is all Pad characters, return True if so, False if not
327 function Is_Padding (Item : String) return Boolean is
328 begin
329 for J in Item'Range loop
330 if Item (J) /= Pad then
331 return False;
332 end if;
333 end loop;
335 return True;
336 end Is_Padding;
338 -- Start of processing for Move
340 begin
341 if Slength = Tlength then
342 Target := Source;
344 elsif Slength > Tlength then
346 case Drop is
347 when Left =>
348 Target := Source (Slast - Tlength + 1 .. Slast);
350 when Right =>
351 Target := Source (Sfirst .. Sfirst + Tlength - 1);
353 when Error =>
354 case Justify is
355 when Left =>
356 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
357 Target :=
358 Source (Sfirst .. Sfirst + Target'Length - 1);
359 else
360 raise Length_Error;
361 end if;
363 when Right =>
364 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
365 Target := Source (Slast - Tlength + 1 .. Slast);
366 else
367 raise Length_Error;
368 end if;
370 when Center =>
371 raise Length_Error;
372 end case;
374 end case;
376 -- Source'Length < Target'Length
378 else
379 case Justify is
380 when Left =>
381 Target (Tfirst .. Tfirst + Slength - 1) := Source;
383 for I in Tfirst + Slength .. Tlast loop
384 Target (I) := Pad;
385 end loop;
387 when Right =>
388 for I in Tfirst .. Tlast - Slength loop
389 Target (I) := Pad;
390 end loop;
392 Target (Tlast - Slength + 1 .. Tlast) := Source;
394 when Center =>
395 declare
396 Front_Pad : constant Integer := (Tlength - Slength) / 2;
397 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
399 begin
400 for I in Tfirst .. Tfirst_Fpad - 1 loop
401 Target (I) := Pad;
402 end loop;
404 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
406 for I in Tfirst_Fpad + Slength .. Tlast loop
407 Target (I) := Pad;
408 end loop;
409 end;
410 end case;
411 end if;
412 end Move;
414 ---------------
415 -- Overwrite --
416 ---------------
418 function Overwrite
419 (Source : String;
420 Position : Positive;
421 New_Item : String) return String
423 begin
424 if Position not in Source'First .. Source'Last + 1 then
425 raise Index_Error;
426 end if;
428 declare
429 Result_Length : constant Natural :=
430 Integer'Max
431 (Source'Length,
432 Position - Source'First + New_Item'Length);
434 Result : String (1 .. Result_Length);
435 Front : constant Integer := Position - Source'First;
437 begin
438 Result (1 .. Front) :=
439 Source (Source'First .. Position - 1);
440 Result (Front + 1 .. Front + New_Item'Length) :=
441 New_Item;
442 Result (Front + New_Item'Length + 1 .. Result'Length) :=
443 Source (Position + New_Item'Length .. Source'Last);
444 return Result;
445 end;
446 end Overwrite;
448 procedure Overwrite
449 (Source : in out String;
450 Position : Positive;
451 New_Item : String;
452 Drop : Truncation := Right)
454 begin
455 Move (Source => Overwrite (Source, Position, New_Item),
456 Target => Source,
457 Drop => Drop);
458 end Overwrite;
460 -------------------
461 -- Replace_Slice --
462 -------------------
464 function Replace_Slice
465 (Source : String;
466 Low : Positive;
467 High : Natural;
468 By : String) return String
470 begin
471 if Low > Source'Last + 1 or High < Source'First - 1 then
472 raise Index_Error;
473 end if;
475 if High >= Low then
476 declare
477 Front_Len : constant Integer :=
478 Integer'Max (0, Low - Source'First);
479 -- Length of prefix of Source copied to result
481 Back_Len : constant Integer :=
482 Integer'Max (0, Source'Last - High);
483 -- Length of suffix of Source copied to result
485 Result_Length : constant Integer :=
486 Front_Len + By'Length + Back_Len;
487 -- Length of result
489 Result : String (1 .. Result_Length);
491 begin
492 Result (1 .. Front_Len) :=
493 Source (Source'First .. Low - 1);
494 Result (Front_Len + 1 .. Front_Len + By'Length) :=
496 Result (Front_Len + By'Length + 1 .. Result'Length) :=
497 Source (High + 1 .. Source'Last);
499 return Result;
500 end;
502 else
503 return Insert (Source, Before => Low, New_Item => By);
504 end if;
505 end Replace_Slice;
507 procedure Replace_Slice
508 (Source : in out String;
509 Low : Positive;
510 High : Natural;
511 By : String;
512 Drop : Truncation := Error;
513 Justify : Alignment := Left;
514 Pad : Character := Space)
516 begin
517 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
518 end Replace_Slice;
520 ----------
521 -- Tail --
522 ----------
524 function Tail
525 (Source : String;
526 Count : Natural;
527 Pad : Character := Space) return String
529 subtype Result_Type is String (1 .. Count);
531 begin
532 if Count < Source'Length then
533 return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
535 -- Pad on left
537 else
538 declare
539 Result : Result_Type;
541 begin
542 for J in 1 .. Count - Source'Length loop
543 Result (J) := Pad;
544 end loop;
546 Result (Count - Source'Length + 1 .. Count) := Source;
547 return Result;
548 end;
549 end if;
550 end Tail;
552 procedure Tail
553 (Source : in out String;
554 Count : Natural;
555 Justify : Alignment := Left;
556 Pad : Character := Space)
558 begin
559 Move (Source => Tail (Source, Count, Pad),
560 Target => Source,
561 Drop => Error,
562 Justify => Justify,
563 Pad => Pad);
564 end Tail;
566 ---------------
567 -- Translate --
568 ---------------
570 function Translate
571 (Source : String;
572 Mapping : Maps.Character_Mapping) return String
574 Result : String (1 .. Source'Length);
576 begin
577 for J in Source'Range loop
578 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
579 end loop;
581 return Result;
582 end Translate;
584 procedure Translate
585 (Source : in out String;
586 Mapping : Maps.Character_Mapping)
588 begin
589 for J in Source'Range loop
590 Source (J) := Value (Mapping, Source (J));
591 end loop;
592 end Translate;
594 function Translate
595 (Source : String;
596 Mapping : Maps.Character_Mapping_Function) return String
598 Result : String (1 .. Source'Length);
599 pragma Unsuppress (Access_Check);
601 begin
602 for J in Source'Range loop
603 Result (J - (Source'First - 1)) := Mapping.all (Source (J));
604 end loop;
606 return Result;
607 end Translate;
609 procedure Translate
610 (Source : in out String;
611 Mapping : Maps.Character_Mapping_Function)
613 pragma Unsuppress (Access_Check);
614 begin
615 for J in Source'Range loop
616 Source (J) := Mapping.all (Source (J));
617 end loop;
618 end Translate;
620 ----------
621 -- Trim --
622 ----------
624 function Trim
625 (Source : String;
626 Side : Trim_End) return String
628 Low, High : Integer;
630 begin
631 Low := Index_Non_Blank (Source, Forward);
633 -- All blanks case
635 if Low = 0 then
636 return "";
638 -- At least one non-blank
640 else
641 High := Index_Non_Blank (Source, Backward);
643 case Side is
644 when Strings.Left =>
645 declare
646 subtype Result_Type is String (1 .. Source'Last - Low + 1);
648 begin
649 return Result_Type (Source (Low .. Source'Last));
650 end;
652 when Strings.Right =>
653 declare
654 subtype Result_Type is String (1 .. High - Source'First + 1);
656 begin
657 return Result_Type (Source (Source'First .. High));
658 end;
660 when Strings.Both =>
661 declare
662 subtype Result_Type is String (1 .. High - Low + 1);
664 begin
665 return Result_Type (Source (Low .. High));
666 end;
667 end case;
668 end if;
669 end Trim;
671 procedure Trim
672 (Source : in out String;
673 Side : Trim_End;
674 Justify : Alignment := Left;
675 Pad : Character := Space)
677 begin
678 Move (Trim (Source, Side),
679 Source,
680 Justify => Justify,
681 Pad => Pad);
682 end Trim;
684 function Trim
685 (Source : String;
686 Left : Maps.Character_Set;
687 Right : Maps.Character_Set) return String
689 High, Low : Integer;
691 begin
692 Low := Index (Source, Set => Left, Test => Outside, Going => Forward);
694 -- Case where source comprises only characters in Left
696 if Low = 0 then
697 return "";
698 end if;
700 High :=
701 Index (Source, Set => Right, Test => Outside, Going => Backward);
703 -- Case where source comprises only characters in Right
705 if High = 0 then
706 return "";
707 end if;
709 declare
710 subtype Result_Type is String (1 .. High - Low + 1);
712 begin
713 return Result_Type (Source (Low .. High));
714 end;
715 end Trim;
717 procedure Trim
718 (Source : in out String;
719 Left : Maps.Character_Set;
720 Right : Maps.Character_Set;
721 Justify : Alignment := Strings.Left;
722 Pad : Character := Space)
724 begin
725 Move (Source => Trim (Source, Left, Right),
726 Target => Source,
727 Justify => Justify,
728 Pad => Pad);
729 end Trim;
731 end Ada.Strings.Fixed;