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-2009, 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 3, 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- Note: This code is derived from the ADAR.CSH public domain Ada 83 versions
33 -- of the Appendix C string handling packages. One change is to avoid the use
34 -- of Is_In, so that we are not dependent on inlining. Note that the search
35 -- function implementations are to be found in the auxiliary package
36 -- Ada.Strings.Search. Also the Move procedure is directly incorporated (ADAR
37 -- used a subunit for this procedure). The number of errors having to do with
38 -- bounds of function return results were also fixed, and use of & removed for
39 -- efficiency reasons.
41 with Ada.Strings.Maps; use Ada.Strings.Maps;
42 with Ada.Strings.Search;
44 package body Ada.Strings.Fixed is
46 ------------------------
47 -- Search Subprograms --
48 ------------------------
53 Going : Direction := Forward;
54 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
55 renames Ada.Strings.Search.Index;
60 Going : Direction := Forward;
61 Mapping : Maps.Character_Mapping_Function) return Natural
62 renames Ada.Strings.Search.Index;
66 Set : Maps.Character_Set;
67 Test : Membership := Inside;
68 Going : Direction := Forward) return Natural
69 renames Ada.Strings.Search.Index;
75 Going : Direction := Forward;
76 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
77 renames Ada.Strings.Search.Index;
83 Going : Direction := Forward;
84 Mapping : Maps.Character_Mapping_Function) return Natural
85 renames Ada.Strings.Search.Index;
89 Set : Maps.Character_Set;
91 Test : Membership := Inside;
92 Going : Direction := Forward) return Natural
93 renames Ada.Strings.Search.Index;
95 function Index_Non_Blank
97 Going : Direction := Forward) return Natural
98 renames Ada.Strings.Search.Index_Non_Blank;
100 function Index_Non_Blank
103 Going : Direction := Forward) return Natural
104 renames Ada.Strings.Search.Index_Non_Blank;
109 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
110 renames Ada.Strings.Search.Count;
115 Mapping : Maps.Character_Mapping_Function) return Natural
116 renames Ada.Strings.Search.Count;
120 Set : Maps.Character_Set) return Natural
121 renames Ada.Strings.Search.Count;
125 Set : Maps.Character_Set;
127 First : out Positive;
129 renames Ada.Strings.Search.Find_Token;
137 Right : Character) return String
139 Result : String (1 .. Left);
142 for J in Result'Range loop
151 Right : String) return String
153 Result : String (1 .. Left * Right'Length);
157 for J in 1 .. Left loop
158 Result (Ptr .. Ptr + Right'Length - 1) := Right;
159 Ptr := Ptr + Right'Length;
172 Through : Natural) return String
175 if From > Through then
177 subtype Result_Type is String (1 .. Source'Length);
180 return Result_Type (Source);
183 elsif From not in Source'Range
184 or else Through > Source'Last
190 Front : constant Integer := From - Source'First;
191 Result : String (1 .. Source'Length - (Through - From + 1));
194 Result (1 .. Front) :=
195 Source (Source'First .. From - 1);
196 Result (Front + 1 .. Result'Last) :=
197 Source (Through + 1 .. Source'Last);
205 (Source : in out String;
208 Justify : Alignment := Left;
209 Pad : Character := Space)
212 Move (Source => Delete (Source, From, Through),
225 Pad : Character := Space) return String
227 subtype Result_Type is String (1 .. Count);
230 if Count < Source'Length then
232 Result_Type (Source (Source'First .. Source'First + Count - 1));
236 Result : Result_Type;
239 Result (1 .. Source'Length) := Source;
241 for J in Source'Length + 1 .. Count loop
251 (Source : in out String;
253 Justify : Alignment := Left;
254 Pad : Character := Space)
257 Move (Source => Head (Source, Count, Pad),
271 New_Item : String) return String
273 Result : String (1 .. Source'Length + New_Item'Length);
274 Front : constant Integer := Before - Source'First;
277 if Before not in Source'First .. Source'Last + 1 then
281 Result (1 .. Front) :=
282 Source (Source'First .. Before - 1);
283 Result (Front + 1 .. Front + New_Item'Length) :=
285 Result (Front + New_Item'Length + 1 .. Result'Last) :=
286 Source (Before .. Source'Last);
292 (Source : in out String;
295 Drop : Truncation := Error)
298 Move (Source => Insert (Source, Before, New_Item),
310 Drop : Truncation := Error;
311 Justify : Alignment := Left;
312 Pad : Character := Space)
314 Sfirst : constant Integer := Source'First;
315 Slast : constant Integer := Source'Last;
316 Slength : constant Integer := Source'Length;
318 Tfirst : constant Integer := Target'First;
319 Tlast : constant Integer := Target'Last;
320 Tlength : constant Integer := Target'Length;
322 function Is_Padding (Item : String) return Boolean;
323 -- Check if Item is all Pad characters, return True if so, False if not
325 function Is_Padding (Item : String) return Boolean is
327 for J in Item'Range loop
328 if Item (J) /= Pad then
336 -- Start of processing for Move
339 if Slength = Tlength then
342 elsif Slength > Tlength then
346 Target := Source (Slast - Tlength + 1 .. Slast);
349 Target := Source (Sfirst .. Sfirst + Tlength - 1);
354 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
356 Source (Sfirst .. Sfirst + Target'Length - 1);
362 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
363 Target := Source (Slast - Tlength + 1 .. Slast);
374 -- Source'Length < Target'Length
379 Target (Tfirst .. Tfirst + Slength - 1) := Source;
381 for I in Tfirst + Slength .. Tlast loop
386 for I in Tfirst .. Tlast - Slength loop
390 Target (Tlast - Slength + 1 .. Tlast) := Source;
394 Front_Pad : constant Integer := (Tlength - Slength) / 2;
395 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
398 for I in Tfirst .. Tfirst_Fpad - 1 loop
402 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
404 for I in Tfirst_Fpad + Slength .. Tlast loop
419 New_Item : String) return String
422 if Position not in Source'First .. Source'Last + 1 then
427 Result_Length : constant Natural :=
430 Position - Source'First + New_Item'Length);
432 Result : String (1 .. Result_Length);
433 Front : constant Integer := Position - Source'First;
436 Result (1 .. Front) :=
437 Source (Source'First .. Position - 1);
438 Result (Front + 1 .. Front + New_Item'Length) :=
440 Result (Front + New_Item'Length + 1 .. Result'Length) :=
441 Source (Position + New_Item'Length .. Source'Last);
447 (Source : in out String;
450 Drop : Truncation := Right)
453 Move (Source => Overwrite (Source, Position, New_Item),
462 function Replace_Slice
466 By : String) return String
469 if Low > Source'Last + 1 or else High < Source'First - 1 then
475 Front_Len : constant Integer :=
476 Integer'Max (0, Low - Source'First);
477 -- Length of prefix of Source copied to result
479 Back_Len : constant Integer :=
480 Integer'Max (0, Source'Last - High);
481 -- Length of suffix of Source copied to result
483 Result_Length : constant Integer :=
484 Front_Len + By'Length + Back_Len;
487 Result : String (1 .. Result_Length);
490 Result (1 .. Front_Len) :=
491 Source (Source'First .. Low - 1);
492 Result (Front_Len + 1 .. Front_Len + By'Length) :=
494 Result (Front_Len + By'Length + 1 .. Result'Length) :=
495 Source (High + 1 .. Source'Last);
501 return Insert (Source, Before => Low, New_Item => By);
505 procedure Replace_Slice
506 (Source : in out String;
510 Drop : Truncation := Error;
511 Justify : Alignment := Left;
512 Pad : Character := Space)
515 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
525 Pad : Character := Space) return String
527 subtype Result_Type is String (1 .. Count);
530 if Count < Source'Length then
531 return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
537 Result : Result_Type;
540 for J in 1 .. Count - Source'Length loop
544 Result (Count - Source'Length + 1 .. Count) := Source;
551 (Source : in out String;
553 Justify : Alignment := Left;
554 Pad : Character := Space)
557 Move (Source => Tail (Source, Count, Pad),
570 Mapping : Maps.Character_Mapping) return String
572 Result : String (1 .. Source'Length);
575 for J in Source'Range loop
576 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
583 (Source : in out String;
584 Mapping : Maps.Character_Mapping)
587 for J in Source'Range loop
588 Source (J) := Value (Mapping, Source (J));
594 Mapping : Maps.Character_Mapping_Function) return String
596 Result : String (1 .. Source'Length);
597 pragma Unsuppress (Access_Check);
600 for J in Source'Range loop
601 Result (J - (Source'First - 1)) := Mapping.all (Source (J));
608 (Source : in out String;
609 Mapping : Maps.Character_Mapping_Function)
611 pragma Unsuppress (Access_Check);
613 for J in Source'Range loop
614 Source (J) := Mapping.all (Source (J));
624 Side : Trim_End) return String
629 Low := Index_Non_Blank (Source, Forward);
636 -- At least one non-blank
639 High := Index_Non_Blank (Source, Backward);
644 subtype Result_Type is String (1 .. Source'Last - Low + 1);
647 return Result_Type (Source (Low .. Source'Last));
650 when Strings.Right =>
652 subtype Result_Type is String (1 .. High - Source'First + 1);
655 return Result_Type (Source (Source'First .. High));
660 subtype Result_Type is String (1 .. High - Low + 1);
663 return Result_Type (Source (Low .. High));
670 (Source : in out String;
672 Justify : Alignment := Left;
673 Pad : Character := Space)
676 Move (Trim (Source, Side),
684 Left : Maps.Character_Set;
685 Right : Maps.Character_Set) return String
690 Low := Index (Source, Set => Left, Test => Outside, Going => Forward);
692 -- Case where source comprises only characters in Left
699 Index (Source, Set => Right, Test => Outside, Going => Backward);
701 -- Case where source comprises only characters in Right
708 subtype Result_Type is String (1 .. High - Low + 1);
711 return Result_Type (Source (Low .. High));
716 (Source : in out String;
717 Left : Maps.Character_Set;
718 Right : Maps.Character_Set;
719 Justify : Alignment := Strings.Left;
720 Pad : Character := Space)
723 Move (Source => Trim (Source, Left, Right),
729 end Ada.Strings.Fixed;