1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . F I X E D --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 -- Note: This code is derived from the ADAR.CSH public domain Ada 83
37 -- versions of the Appendix C string handling packages. One change is
38 -- to avoid the use of Is_In, so that we are not dependent on inlining.
39 -- Note that the search function implementations are to be found in the
40 -- auxiliary package Ada.Strings.Search. Also the Move procedure is
41 -- directly incorporated (ADAR used a subunit for this procedure). A
42 -- number of errors having to do with bounds of function return results
43 -- were also fixed, and use of & removed for efficiency reasons.
45 with Ada.Strings.Maps; use Ada.Strings.Maps;
46 with Ada.Strings.Search;
48 package body Ada.Strings.Fixed is
50 ------------------------
51 -- Search Subprograms --
52 ------------------------
57 Going : in Direction := Forward;
58 Mapping : in Maps.Character_Mapping := Maps.Identity)
60 renames Ada.Strings.Search.Index;
65 Going : in Direction := Forward;
66 Mapping : in Maps.Character_Mapping_Function)
68 renames Ada.Strings.Search.Index;
72 Set : in Maps.Character_Set;
73 Test : in Membership := Inside;
74 Going : in Direction := Forward)
76 renames Ada.Strings.Search.Index;
78 function Index_Non_Blank
80 Going : in Direction := Forward)
82 renames Ada.Strings.Search.Index_Non_Blank;
87 Mapping : in Maps.Character_Mapping := Maps.Identity)
89 renames Ada.Strings.Search.Count;
94 Mapping : in Maps.Character_Mapping_Function)
96 renames Ada.Strings.Search.Count;
100 Set : in Maps.Character_Set)
102 renames Ada.Strings.Search.Count;
106 Set : in Maps.Character_Set;
107 Test : in Membership;
108 First : out Positive;
110 renames Ada.Strings.Search.Find_Token;
118 Right : in Character)
121 Result : String (1 .. Left);
124 for J in Result'Range loop
136 Result : String (1 .. Left * Right'Length);
140 for J in 1 .. Left loop
141 Result (Ptr .. Ptr + Right'Length - 1) := Right;
142 Ptr := Ptr + Right'Length;
155 Through : in Natural)
159 if From > Through then
161 subtype Result_Type is String (1 .. Source'Length);
164 return Result_Type (Source);
167 elsif From not in Source'Range
168 or else Through > Source'Last
174 Front : constant Integer := From - Source'First;
175 Result : String (1 .. Source'Length - (Through - From + 1));
178 Result (1 .. Front) :=
179 Source (Source'First .. From - 1);
180 Result (Front + 1 .. Result'Last) :=
181 Source (Through + 1 .. Source'Last);
189 (Source : in out String;
191 Through : in Natural;
192 Justify : in Alignment := Left;
193 Pad : in Character := Space)
196 Move (Source => Delete (Source, From, Through),
209 Pad : in Character := Space)
212 subtype Result_Type is String (1 .. Count);
215 if Count < Source'Length then
217 Result_Type (Source (Source'First .. Source'First + Count - 1));
221 Result : Result_Type;
224 Result (1 .. Source'Length) := Source;
226 for J in Source'Length + 1 .. Count loop
236 (Source : in out String;
238 Justify : in Alignment := Left;
239 Pad : in Character := Space)
242 Move (Source => Head (Source, Count, Pad),
255 Before : in Positive;
256 New_Item : in String)
259 Result : String (1 .. Source'Length + New_Item'Length);
260 Front : constant Integer := Before - Source'First;
263 if Before not in Source'First .. Source'Last + 1 then
267 Result (1 .. Front) :=
268 Source (Source'First .. Before - 1);
269 Result (Front + 1 .. Front + New_Item'Length) :=
271 Result (Front + New_Item'Length + 1 .. Result'Last) :=
272 Source (Before .. Source'Last);
278 (Source : in out String;
279 Before : in Positive;
280 New_Item : in String;
281 Drop : in Truncation := Error)
284 Move (Source => Insert (Source, Before, New_Item),
296 Drop : in Truncation := Error;
297 Justify : in Alignment := Left;
298 Pad : in Character := Space)
300 Sfirst : constant Integer := Source'First;
301 Slast : constant Integer := Source'Last;
302 Slength : constant Integer := Source'Length;
304 Tfirst : constant Integer := Target'First;
305 Tlast : constant Integer := Target'Last;
306 Tlength : constant Integer := Target'Length;
308 function Is_Padding (Item : String) return Boolean;
309 -- Check if Item is all Pad characters, return True if so, False if not
311 function Is_Padding (Item : String) return Boolean is
313 for J in Item'Range loop
314 if Item (J) /= Pad then
322 -- Start of processing for Move
325 if Slength = Tlength then
328 elsif Slength > Tlength then
332 Target := Source (Slast - Tlength + 1 .. Slast);
335 Target := Source (Sfirst .. Sfirst + Tlength - 1);
340 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
342 Source (Sfirst .. Sfirst + Target'Length - 1);
348 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
349 Target := Source (Slast - Tlength + 1 .. Slast);
360 -- Source'Length < Target'Length
365 Target (Tfirst .. Tfirst + Slength - 1) := Source;
367 for I in Tfirst + Slength .. Tlast loop
372 for I in Tfirst .. Tlast - Slength loop
376 Target (Tlast - Slength + 1 .. Tlast) := Source;
380 Front_Pad : constant Integer := (Tlength - Slength) / 2;
381 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
384 for I in Tfirst .. Tfirst_Fpad - 1 loop
388 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
390 for I in Tfirst_Fpad + Slength .. Tlast loop
404 Position : in Positive;
405 New_Item : in String)
409 if Position not in Source'First .. Source'Last + 1 then
414 Result_Length : Natural :=
416 (Source'Length, Position - Source'First + New_Item'Length);
418 Result : String (1 .. Result_Length);
419 Front : constant Integer := Position - Source'First;
422 Result (1 .. Front) :=
423 Source (Source'First .. Position - 1);
424 Result (Front + 1 .. Front + New_Item'Length) :=
426 Result (Front + New_Item'Length + 1 .. Result'Length) :=
427 Source (Position + New_Item'Length .. Source'Last);
433 (Source : in out String;
434 Position : in Positive;
435 New_Item : in String;
436 Drop : in Truncation := Right)
439 Move (Source => Overwrite (Source, Position, New_Item),
448 function Replace_Slice
456 if Low > Source'Last + 1 or High < Source'First - 1 then
462 Front_Len : constant Integer :=
463 Integer'Max (0, Low - Source'First);
464 -- Length of prefix of Source copied to result
466 Back_Len : constant Integer :=
467 Integer'Max (0, Source'Last - High);
468 -- Length of suffix of Source copied to result
470 Result_Length : constant Integer :=
471 Front_Len + By'Length + Back_Len;
474 Result : String (1 .. Result_Length);
477 Result (1 .. Front_Len) :=
478 Source (Source'First .. Low - 1);
479 Result (Front_Len + 1 .. Front_Len + By'Length) :=
481 Result (Front_Len + By'Length + 1 .. Result'Length) :=
482 Source (High + 1 .. Source'Last);
488 return Insert (Source, Before => Low, New_Item => By);
492 procedure Replace_Slice
493 (Source : in out String;
497 Drop : in Truncation := Error;
498 Justify : in Alignment := Left;
499 Pad : in Character := Space)
502 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
512 Pad : in Character := Space)
515 subtype Result_Type is String (1 .. Count);
518 if Count < Source'Length then
519 return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
525 Result : Result_Type;
528 for J in 1 .. Count - Source'Length loop
532 Result (Count - Source'Length + 1 .. Count) := Source;
539 (Source : in out String;
541 Justify : in Alignment := Left;
542 Pad : in Character := Space)
545 Move (Source => Tail (Source, Count, Pad),
558 Mapping : in Maps.Character_Mapping)
561 Result : String (1 .. Source'Length);
564 for J in Source'Range loop
565 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
572 (Source : in out String;
573 Mapping : in Maps.Character_Mapping)
576 for J in Source'Range loop
577 Source (J) := Value (Mapping, Source (J));
583 Mapping : in Maps.Character_Mapping_Function)
586 Result : String (1 .. Source'Length);
587 pragma Unsuppress (Access_Check);
590 for J in Source'Range loop
591 Result (J - (Source'First - 1)) := Mapping.all (Source (J));
598 (Source : in out String;
599 Mapping : in Maps.Character_Mapping_Function)
601 pragma Unsuppress (Access_Check);
603 for J in Source'Range loop
604 Source (J) := Mapping.all (Source (J));
620 Low := Index_Non_Blank (Source, Forward);
627 -- At least one non-blank
630 High := Index_Non_Blank (Source, Backward);
635 subtype Result_Type is String (1 .. Source'Last - Low + 1);
638 return Result_Type (Source (Low .. Source'Last));
641 when Strings.Right =>
643 subtype Result_Type is String (1 .. High - Source'First + 1);
646 return Result_Type (Source (Source'First .. High));
651 subtype Result_Type is String (1 .. High - Low + 1);
654 return Result_Type (Source (Low .. High));
661 (Source : in out String;
663 Justify : in Alignment := Left;
664 Pad : in Character := Space)
667 Move (Trim (Source, Side),
675 Left : in Maps.Character_Set;
676 Right : in Maps.Character_Set)
682 Low := Index (Source, Set => Left, Test => Outside, Going => Forward);
684 -- Case where source comprises only characters in Left
691 Index (Source, Set => Right, Test => Outside, Going => Backward);
693 -- Case where source comprises only characters in Right
700 subtype Result_Type is String (1 .. High - Low + 1);
703 return Result_Type (Source (Low .. High));
708 (Source : in out String;
709 Left : in Maps.Character_Set;
710 Right : in Maps.Character_Set;
711 Justify : in Alignment := Strings.Left;
712 Pad : in Character := Space)
715 Move (Source => Trim (Source, Left, Right),
721 end Ada.Strings.Fixed;