1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . S T R I N G S . F I X E D --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
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. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- Note: This code is derived from the ADAR.CSH public domain Ada 83 versions
35 -- of the Appendix C string handling packages. One change is to avoid the use
36 -- of Is_In, so that we are not dependent on inlining. Note that the search
37 -- function implementations are to be found in the auxiliary package
38 -- Ada.Strings.Search. Also the Move procedure is directly incorporated (ADAR
39 -- used a subunit for this procedure). number of errors having to do with
40 -- bounds of function return results were also fixed, and use of & removed for
41 -- 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 ------------------------
55 Going : Direction := Forward;
56 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
57 renames Ada.Strings.Search.Index;
62 Going : Direction := Forward;
63 Mapping : Maps.Character_Mapping_Function) return Natural
64 renames Ada.Strings.Search.Index;
68 Set : Maps.Character_Set;
69 Test : Membership := Inside;
70 Going : Direction := Forward) return Natural
71 renames Ada.Strings.Search.Index;
77 Going : Direction := Forward;
78 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
79 renames Ada.Strings.Search.Index;
85 Going : Direction := Forward;
86 Mapping : Maps.Character_Mapping_Function) return Natural
87 renames Ada.Strings.Search.Index;
91 Set : Maps.Character_Set;
93 Test : Membership := Inside;
94 Going : Direction := Forward) return Natural
95 renames Ada.Strings.Search.Index;
97 function Index_Non_Blank
99 Going : Direction := Forward) return Natural
100 renames Ada.Strings.Search.Index_Non_Blank;
102 function Index_Non_Blank
105 Going : Direction := Forward) return Natural
106 renames Ada.Strings.Search.Index_Non_Blank;
111 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
112 renames Ada.Strings.Search.Count;
117 Mapping : Maps.Character_Mapping_Function) return Natural
118 renames Ada.Strings.Search.Count;
122 Set : Maps.Character_Set) return Natural
123 renames Ada.Strings.Search.Count;
127 Set : Maps.Character_Set;
129 First : out Positive;
131 renames Ada.Strings.Search.Find_Token;
139 Right : Character) return String
141 Result : String (1 .. Left);
144 for J in Result'Range loop
153 Right : String) return String
155 Result : String (1 .. Left * Right'Length);
159 for J in 1 .. Left loop
160 Result (Ptr .. Ptr + Right'Length - 1) := Right;
161 Ptr := Ptr + Right'Length;
174 Through : Natural) return String
177 if From > Through then
179 subtype Result_Type is String (1 .. Source'Length);
182 return Result_Type (Source);
185 elsif From not in Source'Range
186 or else Through > Source'Last
192 Front : constant Integer := From - Source'First;
193 Result : String (1 .. Source'Length - (Through - From + 1));
196 Result (1 .. Front) :=
197 Source (Source'First .. From - 1);
198 Result (Front + 1 .. Result'Last) :=
199 Source (Through + 1 .. Source'Last);
207 (Source : in out String;
210 Justify : Alignment := Left;
211 Pad : Character := Space)
214 Move (Source => Delete (Source, From, Through),
227 Pad : Character := Space) return String
229 subtype Result_Type is String (1 .. Count);
232 if Count < Source'Length then
234 Result_Type (Source (Source'First .. Source'First + Count - 1));
238 Result : Result_Type;
241 Result (1 .. Source'Length) := Source;
243 for J in Source'Length + 1 .. Count loop
253 (Source : in out String;
255 Justify : Alignment := Left;
256 Pad : Character := Space)
259 Move (Source => Head (Source, Count, Pad),
273 New_Item : String) return String
275 Result : String (1 .. Source'Length + New_Item'Length);
276 Front : constant Integer := Before - Source'First;
279 if Before not in Source'First .. Source'Last + 1 then
283 Result (1 .. Front) :=
284 Source (Source'First .. Before - 1);
285 Result (Front + 1 .. Front + New_Item'Length) :=
287 Result (Front + New_Item'Length + 1 .. Result'Last) :=
288 Source (Before .. Source'Last);
294 (Source : in out String;
297 Drop : Truncation := Error)
300 Move (Source => Insert (Source, Before, New_Item),
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
329 for J in Item'Range loop
330 if Item (J) /= Pad then
338 -- Start of processing for Move
341 if Slength = Tlength then
344 elsif Slength > Tlength then
348 Target := Source (Slast - Tlength + 1 .. Slast);
351 Target := Source (Sfirst .. Sfirst + Tlength - 1);
356 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
358 Source (Sfirst .. Sfirst + Target'Length - 1);
364 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
365 Target := Source (Slast - Tlength + 1 .. Slast);
376 -- Source'Length < Target'Length
381 Target (Tfirst .. Tfirst + Slength - 1) := Source;
383 for I in Tfirst + Slength .. Tlast loop
388 for I in Tfirst .. Tlast - Slength loop
392 Target (Tlast - Slength + 1 .. Tlast) := Source;
396 Front_Pad : constant Integer := (Tlength - Slength) / 2;
397 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
400 for I in Tfirst .. Tfirst_Fpad - 1 loop
404 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
406 for I in Tfirst_Fpad + Slength .. Tlast loop
421 New_Item : String) return String
424 if Position not in Source'First .. Source'Last + 1 then
429 Result_Length : constant Natural :=
432 Position - Source'First + New_Item'Length);
434 Result : String (1 .. Result_Length);
435 Front : constant Integer := Position - Source'First;
438 Result (1 .. Front) :=
439 Source (Source'First .. Position - 1);
440 Result (Front + 1 .. Front + New_Item'Length) :=
442 Result (Front + New_Item'Length + 1 .. Result'Length) :=
443 Source (Position + New_Item'Length .. Source'Last);
449 (Source : in out String;
452 Drop : Truncation := Right)
455 Move (Source => Overwrite (Source, Position, New_Item),
464 function Replace_Slice
468 By : String) return String
471 if Low > Source'Last + 1 or High < Source'First - 1 then
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;
489 Result : String (1 .. Result_Length);
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);
503 return Insert (Source, Before => Low, New_Item => By);
507 procedure Replace_Slice
508 (Source : in out String;
512 Drop : Truncation := Error;
513 Justify : Alignment := Left;
514 Pad : Character := Space)
517 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
527 Pad : Character := Space) return String
529 subtype Result_Type is String (1 .. Count);
532 if Count < Source'Length then
533 return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
539 Result : Result_Type;
542 for J in 1 .. Count - Source'Length loop
546 Result (Count - Source'Length + 1 .. Count) := Source;
553 (Source : in out String;
555 Justify : Alignment := Left;
556 Pad : Character := Space)
559 Move (Source => Tail (Source, Count, Pad),
572 Mapping : Maps.Character_Mapping) return String
574 Result : String (1 .. Source'Length);
577 for J in Source'Range loop
578 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
585 (Source : in out String;
586 Mapping : Maps.Character_Mapping)
589 for J in Source'Range loop
590 Source (J) := Value (Mapping, Source (J));
596 Mapping : Maps.Character_Mapping_Function) return String
598 Result : String (1 .. Source'Length);
599 pragma Unsuppress (Access_Check);
602 for J in Source'Range loop
603 Result (J - (Source'First - 1)) := Mapping.all (Source (J));
610 (Source : in out String;
611 Mapping : Maps.Character_Mapping_Function)
613 pragma Unsuppress (Access_Check);
615 for J in Source'Range loop
616 Source (J) := Mapping.all (Source (J));
626 Side : Trim_End) return String
631 Low := Index_Non_Blank (Source, Forward);
638 -- At least one non-blank
641 High := Index_Non_Blank (Source, Backward);
646 subtype Result_Type is String (1 .. Source'Last - Low + 1);
649 return Result_Type (Source (Low .. Source'Last));
652 when Strings.Right =>
654 subtype Result_Type is String (1 .. High - Source'First + 1);
657 return Result_Type (Source (Source'First .. High));
662 subtype Result_Type is String (1 .. High - Low + 1);
665 return Result_Type (Source (Low .. High));
672 (Source : in out String;
674 Justify : Alignment := Left;
675 Pad : Character := Space)
678 Move (Trim (Source, Side),
686 Left : Maps.Character_Set;
687 Right : Maps.Character_Set) return String
692 Low := Index (Source, Set => Left, Test => Outside, Going => Forward);
694 -- Case where source comprises only characters in Left
701 Index (Source, Set => Right, Test => Outside, Going => Backward);
703 -- Case where source comprises only characters in Right
710 subtype Result_Type is String (1 .. High - Low + 1);
713 return Result_Type (Source (Low .. High));
718 (Source : in out String;
719 Left : Maps.Character_Set;
720 Right : Maps.Character_Set;
721 Justify : Alignment := Strings.Left;
722 Pad : Character := Space)
725 Move (Source => Trim (Source, Left, Right),
731 end Ada.Strings.Fixed;