1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . F I X E D --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 -- Note: This code is derived from the ADAR.CSH public domain Ada 83
36 -- versions of the Appendix C string handling packages. One change is
37 -- to avoid the use of Is_In, so that we are not dependent on inlining.
38 -- Note that the search function implementations are to be found in the
39 -- auxiliary package Ada.Strings.Search. Also the Move procedure is
40 -- directly incorporated (ADAR used a subunit for this procedure). A
41 -- number of errors having to do with bounds of function return results
42 -- were also fixed, and use of & removed for efficiency reasons.
44 with Ada
.Strings
.Maps
; use Ada
.Strings
.Maps
;
45 with Ada
.Strings
.Search
;
47 package body Ada
.Strings
.Fixed
is
49 ------------------------
50 -- Search Subprograms --
51 ------------------------
56 Going
: in Direction
:= Forward
;
57 Mapping
: in Maps
.Character_Mapping
:= Maps
.Identity
)
59 renames Ada
.Strings
.Search
.Index
;
64 Going
: in Direction
:= Forward
;
65 Mapping
: in Maps
.Character_Mapping_Function
)
67 renames Ada
.Strings
.Search
.Index
;
71 Set
: in Maps
.Character_Set
;
72 Test
: in Membership
:= Inside
;
73 Going
: in Direction
:= Forward
)
75 renames Ada
.Strings
.Search
.Index
;
77 function Index_Non_Blank
79 Going
: in Direction
:= Forward
)
81 renames Ada
.Strings
.Search
.Index_Non_Blank
;
86 Mapping
: in Maps
.Character_Mapping
:= Maps
.Identity
)
88 renames Ada
.Strings
.Search
.Count
;
93 Mapping
: in Maps
.Character_Mapping_Function
)
95 renames Ada
.Strings
.Search
.Count
;
99 Set
: in Maps
.Character_Set
)
101 renames Ada
.Strings
.Search
.Count
;
105 Set
: in Maps
.Character_Set
;
106 Test
: in Membership
;
107 First
: out Positive;
109 renames Ada
.Strings
.Search
.Find_Token
;
117 Right
: in Character)
120 Result
: String (1 .. Left
);
123 for J
in Result
'Range loop
135 Result
: String (1 .. Left
* Right
'Length);
139 for J
in 1 .. Left
loop
140 Result
(Ptr
.. Ptr
+ Right
'Length - 1) := Right
;
141 Ptr
:= Ptr
+ Right
'Length;
154 Through
: in Natural)
158 if From
> Through
then
160 subtype Result_Type
is String (1 .. Source
'Length);
163 return Result_Type
(Source
);
166 elsif From
not in Source
'Range
167 or else Through
> Source
'Last
173 Front
: constant Integer := From
- Source
'First;
174 Result
: String (1 .. Source
'Length - (Through
- From
+ 1));
177 Result
(1 .. Front
) :=
178 Source
(Source
'First .. From
- 1);
179 Result
(Front
+ 1 .. Result
'Last) :=
180 Source
(Through
+ 1 .. Source
'Last);
188 (Source
: in out String;
190 Through
: in Natural;
191 Justify
: in Alignment
:= Left
;
192 Pad
: in Character := Space
)
195 Move
(Source
=> Delete
(Source
, From
, Through
),
208 Pad
: in Character := Space
)
211 subtype Result_Type
is String (1 .. Count
);
214 if Count
< Source
'Length then
216 Result_Type
(Source
(Source
'First .. Source
'First + Count
- 1));
220 Result
: Result_Type
;
223 Result
(1 .. Source
'Length) := Source
;
225 for J
in Source
'Length + 1 .. Count
loop
235 (Source
: in out String;
237 Justify
: in Alignment
:= Left
;
238 Pad
: in Character := Space
)
241 Move
(Source
=> Head
(Source
, Count
, Pad
),
254 Before
: in Positive;
255 New_Item
: in String)
258 Result
: String (1 .. Source
'Length + New_Item
'Length);
259 Front
: constant Integer := Before
- Source
'First;
262 if Before
not in Source
'First .. Source
'Last + 1 then
266 Result
(1 .. Front
) :=
267 Source
(Source
'First .. Before
- 1);
268 Result
(Front
+ 1 .. Front
+ New_Item
'Length) :=
270 Result
(Front
+ New_Item
'Length + 1 .. Result
'Last) :=
271 Source
(Before
.. Source
'Last);
277 (Source
: in out String;
278 Before
: in Positive;
279 New_Item
: in String;
280 Drop
: in Truncation
:= Error
)
283 Move
(Source
=> Insert
(Source
, Before
, New_Item
),
295 Drop
: in Truncation
:= Error
;
296 Justify
: in Alignment
:= Left
;
297 Pad
: in Character := Space
)
299 Sfirst
: constant Integer := Source
'First;
300 Slast
: constant Integer := Source
'Last;
301 Slength
: constant Integer := Source
'Length;
303 Tfirst
: constant Integer := Target
'First;
304 Tlast
: constant Integer := Target
'Last;
305 Tlength
: constant Integer := Target
'Length;
307 function Is_Padding
(Item
: String) return Boolean;
308 -- Check if Item is all Pad characters, return True if so, False if not
310 function Is_Padding
(Item
: String) return Boolean is
312 for J
in Item
'Range loop
313 if Item
(J
) /= Pad
then
321 -- Start of processing for Move
324 if Slength
= Tlength
then
327 elsif Slength
> Tlength
then
331 Target
:= Source
(Slast
- Tlength
+ 1 .. Slast
);
334 Target
:= Source
(Sfirst
.. Sfirst
+ Tlength
- 1);
339 if Is_Padding
(Source
(Sfirst
+ Tlength
.. Slast
)) then
341 Source
(Sfirst
.. Sfirst
+ Target
'Length - 1);
347 if Is_Padding
(Source
(Sfirst
.. Slast
- Tlength
)) then
348 Target
:= Source
(Slast
- Tlength
+ 1 .. Slast
);
359 -- Source'Length < Target'Length
364 Target
(Tfirst
.. Tfirst
+ Slength
- 1) := Source
;
366 for I
in Tfirst
+ Slength
.. Tlast
loop
371 for I
in Tfirst
.. Tlast
- Slength
loop
375 Target
(Tlast
- Slength
+ 1 .. Tlast
) := Source
;
379 Front_Pad
: constant Integer := (Tlength
- Slength
) / 2;
380 Tfirst_Fpad
: constant Integer := Tfirst
+ Front_Pad
;
383 for I
in Tfirst
.. Tfirst_Fpad
- 1 loop
387 Target
(Tfirst_Fpad
.. Tfirst_Fpad
+ Slength
- 1) := Source
;
389 for I
in Tfirst_Fpad
+ Slength
.. Tlast
loop
403 Position
: in Positive;
404 New_Item
: in String)
408 if Position
not in Source
'First .. Source
'Last + 1 then
413 Result_Length
: Natural :=
415 (Source
'Length, Position
- Source
'First + New_Item
'Length);
417 Result
: String (1 .. Result_Length
);
418 Front
: constant Integer := Position
- Source
'First;
421 Result
(1 .. Front
) :=
422 Source
(Source
'First .. Position
- 1);
423 Result
(Front
+ 1 .. Front
+ New_Item
'Length) :=
425 Result
(Front
+ New_Item
'Length + 1 .. Result
'Length) :=
426 Source
(Position
+ New_Item
'Length .. Source
'Last);
432 (Source
: in out String;
433 Position
: in Positive;
434 New_Item
: in String;
435 Drop
: in Truncation
:= Right
)
438 Move
(Source
=> Overwrite
(Source
, Position
, New_Item
),
447 function Replace_Slice
455 if Low
> Source
'Last + 1 or High
< Source
'First - 1 then
461 Front_Len
: constant Integer :=
462 Integer'Max (0, Low
- Source
'First);
463 -- Length of prefix of Source copied to result
465 Back_Len
: constant Integer :=
466 Integer'Max (0, Source
'Last - High
);
467 -- Length of suffix of Source copied to result
469 Result_Length
: constant Integer :=
470 Front_Len
+ By
'Length + Back_Len
;
473 Result
: String (1 .. Result_Length
);
476 Result
(1 .. Front_Len
) :=
477 Source
(Source
'First .. Low
- 1);
478 Result
(Front_Len
+ 1 .. Front_Len
+ By
'Length) :=
480 Result
(Front_Len
+ By
'Length + 1 .. Result
'Length) :=
481 Source
(High
+ 1 .. Source
'Last);
487 return Insert
(Source
, Before
=> Low
, New_Item
=> By
);
491 procedure Replace_Slice
492 (Source
: in out String;
496 Drop
: in Truncation
:= Error
;
497 Justify
: in Alignment
:= Left
;
498 Pad
: in Character := Space
)
501 Move
(Replace_Slice
(Source
, Low
, High
, By
), Source
, Drop
, Justify
, Pad
);
511 Pad
: in Character := Space
)
514 subtype Result_Type
is String (1 .. Count
);
517 if Count
< Source
'Length then
518 return Result_Type
(Source
(Source
'Last - Count
+ 1 .. Source
'Last));
524 Result
: Result_Type
;
527 for J
in 1 .. Count
- Source
'Length loop
531 Result
(Count
- Source
'Length + 1 .. Count
) := Source
;
538 (Source
: in out String;
540 Justify
: in Alignment
:= Left
;
541 Pad
: in Character := Space
)
544 Move
(Source
=> Tail
(Source
, Count
, Pad
),
557 Mapping
: in Maps
.Character_Mapping
)
560 Result
: String (1 .. Source
'Length);
563 for J
in Source
'Range loop
564 Result
(J
- (Source
'First - 1)) := Value
(Mapping
, Source
(J
));
571 (Source
: in out String;
572 Mapping
: in Maps
.Character_Mapping
)
575 for J
in Source
'Range loop
576 Source
(J
) := Value
(Mapping
, Source
(J
));
582 Mapping
: in Maps
.Character_Mapping_Function
)
585 Result
: String (1 .. Source
'Length);
586 pragma Unsuppress
(Access_Check
);
589 for J
in Source
'Range loop
590 Result
(J
- (Source
'First - 1)) := Mapping
.all (Source
(J
));
597 (Source
: in out String;
598 Mapping
: in Maps
.Character_Mapping_Function
)
600 pragma Unsuppress
(Access_Check
);
602 for J
in Source
'Range loop
603 Source
(J
) := Mapping
.all (Source
(J
));
619 Low
:= Index_Non_Blank
(Source
, Forward
);
626 -- At least one non-blank
629 High
:= Index_Non_Blank
(Source
, Backward
);
634 subtype Result_Type
is String (1 .. Source
'Last - Low
+ 1);
637 return Result_Type
(Source
(Low
.. Source
'Last));
640 when Strings
.Right
=>
642 subtype Result_Type
is String (1 .. High
- Source
'First + 1);
645 return Result_Type
(Source
(Source
'First .. High
));
650 subtype Result_Type
is String (1 .. High
- Low
+ 1);
653 return Result_Type
(Source
(Low
.. High
));
660 (Source
: in out String;
662 Justify
: in Alignment
:= Left
;
663 Pad
: in Character := Space
)
666 Move
(Trim
(Source
, Side
),
674 Left
: in Maps
.Character_Set
;
675 Right
: in Maps
.Character_Set
)
681 Low
:= Index
(Source
, Set
=> Left
, Test
=> Outside
, Going
=> Forward
);
683 -- Case where source comprises only characters in Left
690 Index
(Source
, Set
=> Right
, Test
=> Outside
, Going
=> Backward
);
692 -- Case where source comprises only characters in Right
699 subtype Result_Type
is String (1 .. High
- Low
+ 1);
702 return Result_Type
(Source
(Low
.. High
));
707 (Source
: in out String;
708 Left
: in Maps
.Character_Set
;
709 Right
: in Maps
.Character_Set
;
710 Justify
: in Alignment
:= Strings
.Left
;
711 Pad
: in Character := Space
)
714 Move
(Source
=> Trim
(Source
, Left
, Right
),
720 end Ada
.Strings
.Fixed
;