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-2012, 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;
128 First : out Positive;
130 renames Ada.Strings.Search.Find_Token;
134 Set : Maps.Character_Set;
136 First : out Positive;
138 renames Ada.Strings.Search.Find_Token;
146 Right : Character) return String
148 Result : String (1 .. Left);
151 for J in Result'Range loop
160 Right : String) return String
162 Result : String (1 .. Left * Right'Length);
166 for J in 1 .. Left loop
167 Result (Ptr .. Ptr + Right'Length - 1) := Right;
168 Ptr := Ptr + Right'Length;
181 Through : Natural) return String
184 if From > Through then
186 subtype Result_Type is String (1 .. Source'Length);
189 return Result_Type (Source);
192 elsif From not in Source'Range
193 or else Through > Source'Last
199 Front : constant Integer := From - Source'First;
200 Result : String (1 .. Source'Length - (Through - From + 1));
203 Result (1 .. Front) :=
204 Source (Source'First .. From - 1);
205 Result (Front + 1 .. Result'Last) :=
206 Source (Through + 1 .. Source'Last);
214 (Source : in out String;
217 Justify : Alignment := Left;
218 Pad : Character := Space)
221 Move (Source => Delete (Source, From, Through),
234 Pad : Character := Space) return String
236 subtype Result_Type is String (1 .. Count);
239 if Count < Source'Length then
241 Result_Type (Source (Source'First .. Source'First + Count - 1));
245 Result : Result_Type;
248 Result (1 .. Source'Length) := Source;
250 for J in Source'Length + 1 .. Count loop
260 (Source : in out String;
262 Justify : Alignment := Left;
263 Pad : Character := Space)
266 Move (Source => Head (Source, Count, Pad),
280 New_Item : String) return String
282 Result : String (1 .. Source'Length + New_Item'Length);
283 Front : constant Integer := Before - Source'First;
286 if Before not in Source'First .. Source'Last + 1 then
290 Result (1 .. Front) :=
291 Source (Source'First .. Before - 1);
292 Result (Front + 1 .. Front + New_Item'Length) :=
294 Result (Front + New_Item'Length + 1 .. Result'Last) :=
295 Source (Before .. Source'Last);
301 (Source : in out String;
304 Drop : Truncation := Error)
307 Move (Source => Insert (Source, Before, New_Item),
319 Drop : Truncation := Error;
320 Justify : Alignment := Left;
321 Pad : Character := Space)
323 Sfirst : constant Integer := Source'First;
324 Slast : constant Integer := Source'Last;
325 Slength : constant Integer := Source'Length;
327 Tfirst : constant Integer := Target'First;
328 Tlast : constant Integer := Target'Last;
329 Tlength : constant Integer := Target'Length;
331 function Is_Padding (Item : String) return Boolean;
332 -- Check if Item is all Pad characters, return True if so, False if not
334 function Is_Padding (Item : String) return Boolean is
336 for J in Item'Range loop
337 if Item (J) /= Pad then
345 -- Start of processing for Move
348 if Slength = Tlength then
351 elsif Slength > Tlength then
355 Target := Source (Slast - Tlength + 1 .. Slast);
358 Target := Source (Sfirst .. Sfirst + Tlength - 1);
363 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
365 Source (Sfirst .. Sfirst + Target'Length - 1);
371 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
372 Target := Source (Slast - Tlength + 1 .. Slast);
383 -- Source'Length < Target'Length
388 Target (Tfirst .. Tfirst + Slength - 1) := Source;
390 for I in Tfirst + Slength .. Tlast loop
395 for I in Tfirst .. Tlast - Slength loop
399 Target (Tlast - Slength + 1 .. Tlast) := Source;
403 Front_Pad : constant Integer := (Tlength - Slength) / 2;
404 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
407 for I in Tfirst .. Tfirst_Fpad - 1 loop
411 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
413 for I in Tfirst_Fpad + Slength .. Tlast loop
428 New_Item : String) return String
431 if Position not in Source'First .. Source'Last + 1 then
436 Result_Length : constant Natural :=
439 Position - Source'First + New_Item'Length);
441 Result : String (1 .. Result_Length);
442 Front : constant Integer := Position - Source'First;
445 Result (1 .. Front) :=
446 Source (Source'First .. Position - 1);
447 Result (Front + 1 .. Front + New_Item'Length) :=
449 Result (Front + New_Item'Length + 1 .. Result'Length) :=
450 Source (Position + New_Item'Length .. Source'Last);
456 (Source : in out String;
459 Drop : Truncation := Right)
462 Move (Source => Overwrite (Source, Position, New_Item),
471 function Replace_Slice
475 By : String) return String
478 if Low > Source'Last + 1 or else High < Source'First - 1 then
484 Front_Len : constant Integer :=
485 Integer'Max (0, Low - Source'First);
486 -- Length of prefix of Source copied to result
488 Back_Len : constant Integer :=
489 Integer'Max (0, Source'Last - High);
490 -- Length of suffix of Source copied to result
492 Result_Length : constant Integer :=
493 Front_Len + By'Length + Back_Len;
496 Result : String (1 .. Result_Length);
499 Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
500 Result (Front_Len + 1 .. Front_Len + By'Length) := By;
501 Result (Front_Len + By'Length + 1 .. Result'Length) :=
502 Source (High + 1 .. Source'Last);
507 return Insert (Source, Before => Low, New_Item => By);
511 procedure Replace_Slice
512 (Source : in out String;
516 Drop : Truncation := Error;
517 Justify : Alignment := Left;
518 Pad : Character := Space)
521 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
531 Pad : Character := Space) return String
533 subtype Result_Type is String (1 .. Count);
536 if Count < Source'Length then
537 return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
543 Result : Result_Type;
546 for J in 1 .. Count - Source'Length loop
550 Result (Count - Source'Length + 1 .. Count) := Source;
557 (Source : in out String;
559 Justify : Alignment := Left;
560 Pad : Character := Space)
563 Move (Source => Tail (Source, Count, Pad),
576 Mapping : Maps.Character_Mapping) return String
578 Result : String (1 .. Source'Length);
581 for J in Source'Range loop
582 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
589 (Source : in out String;
590 Mapping : Maps.Character_Mapping)
593 for J in Source'Range loop
594 Source (J) := Value (Mapping, Source (J));
600 Mapping : Maps.Character_Mapping_Function) return String
602 Result : String (1 .. Source'Length);
603 pragma Unsuppress (Access_Check);
606 for J in Source'Range loop
607 Result (J - (Source'First - 1)) := Mapping.all (Source (J));
614 (Source : in out String;
615 Mapping : Maps.Character_Mapping_Function)
617 pragma Unsuppress (Access_Check);
619 for J in Source'Range loop
620 Source (J) := Mapping.all (Source (J));
630 Side : Trim_End) return String
635 Low := Index_Non_Blank (Source, Forward);
642 -- At least one non-blank
645 High := Index_Non_Blank (Source, Backward);
650 subtype Result_Type is String (1 .. Source'Last - Low + 1);
653 return Result_Type (Source (Low .. Source'Last));
656 when Strings.Right =>
658 subtype Result_Type is String (1 .. High - Source'First + 1);
661 return Result_Type (Source (Source'First .. High));
666 subtype Result_Type is String (1 .. High - Low + 1);
669 return Result_Type (Source (Low .. High));
676 (Source : in out String;
678 Justify : Alignment := Left;
679 Pad : Character := Space)
682 Move (Trim (Source, Side),
690 Left : Maps.Character_Set;
691 Right : Maps.Character_Set) return String
696 Low := Index (Source, Set => Left, Test => Outside, Going => Forward);
698 -- Case where source comprises only characters in Left
705 Index (Source, Set => Right, Test => Outside, Going => Backward);
707 -- Case where source comprises only characters in Right
714 subtype Result_Type is String (1 .. High - Low + 1);
717 return Result_Type (Source (Low .. High));
722 (Source : in out String;
723 Left : Maps.Character_Set;
724 Right : Maps.Character_Set;
725 Justify : Alignment := Strings.Left;
726 Pad : Character := Space)
729 Move (Source => Trim (Source, Left, Right),
735 end Ada.Strings.Fixed;