|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . S T R I N G S . F I X E D --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
17 -- --
|
|
|
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. --
|
|
|
21 -- --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
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.
|
|
|
40
|
|
|
41 with Ada.Strings.Maps; use Ada.Strings.Maps;
|
|
|
42 with Ada.Strings.Search;
|
|
|
43
|
|
|
44 package body Ada.Strings.Fixed is
|
|
|
45
|
|
|
46 ------------------------
|
|
|
47 -- Search Subprograms --
|
|
|
48 ------------------------
|
|
|
49
|
|
|
50 function Index
|
|
|
51 (Source : String;
|
|
|
52 Pattern : String;
|
|
|
53 Going : Direction := Forward;
|
|
|
54 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
|
|
|
55 renames Ada.Strings.Search.Index;
|
|
|
56
|
|
|
57 function Index
|
|
|
58 (Source : String;
|
|
|
59 Pattern : String;
|
|
|
60 Going : Direction := Forward;
|
|
|
61 Mapping : Maps.Character_Mapping_Function) return Natural
|
|
|
62 renames Ada.Strings.Search.Index;
|
|
|
63
|
|
|
64 function Index
|
|
|
65 (Source : String;
|
|
|
66 Set : Maps.Character_Set;
|
|
|
67 Test : Membership := Inside;
|
|
|
68 Going : Direction := Forward) return Natural
|
|
|
69 renames Ada.Strings.Search.Index;
|
|
|
70
|
|
|
71 function Index
|
|
|
72 (Source : String;
|
|
|
73 Pattern : String;
|
|
|
74 From : Positive;
|
|
|
75 Going : Direction := Forward;
|
|
|
76 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
|
|
|
77 renames Ada.Strings.Search.Index;
|
|
|
78
|
|
|
79 function Index
|
|
|
80 (Source : String;
|
|
|
81 Pattern : String;
|
|
|
82 From : Positive;
|
|
|
83 Going : Direction := Forward;
|
|
|
84 Mapping : Maps.Character_Mapping_Function) return Natural
|
|
|
85 renames Ada.Strings.Search.Index;
|
|
|
86
|
|
|
87 function Index
|
|
|
88 (Source : String;
|
|
|
89 Set : Maps.Character_Set;
|
|
|
90 From : Positive;
|
|
|
91 Test : Membership := Inside;
|
|
|
92 Going : Direction := Forward) return Natural
|
|
|
93 renames Ada.Strings.Search.Index;
|
|
|
94
|
|
|
95 function Index_Non_Blank
|
|
|
96 (Source : String;
|
|
|
97 Going : Direction := Forward) return Natural
|
|
|
98 renames Ada.Strings.Search.Index_Non_Blank;
|
|
|
99
|
|
|
100 function Index_Non_Blank
|
|
|
101 (Source : String;
|
|
|
102 From : Positive;
|
|
|
103 Going : Direction := Forward) return Natural
|
|
|
104 renames Ada.Strings.Search.Index_Non_Blank;
|
|
|
105
|
|
|
106 function Count
|
|
|
107 (Source : String;
|
|
|
108 Pattern : String;
|
|
|
109 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
|
|
|
110 renames Ada.Strings.Search.Count;
|
|
|
111
|
|
|
112 function Count
|
|
|
113 (Source : String;
|
|
|
114 Pattern : String;
|
|
|
115 Mapping : Maps.Character_Mapping_Function) return Natural
|
|
|
116 renames Ada.Strings.Search.Count;
|
|
|
117
|
|
|
118 function Count
|
|
|
119 (Source : String;
|
|
|
120 Set : Maps.Character_Set) return Natural
|
|
|
121 renames Ada.Strings.Search.Count;
|
|
|
122
|
|
|
123 procedure Find_Token
|
|
|
124 (Source : String;
|
|
|
125 Set : Maps.Character_Set;
|
|
|
126 From : Positive;
|
|
|
127 Test : Membership;
|
|
|
128 First : out Positive;
|
|
|
129 Last : out Natural)
|
|
|
130 renames Ada.Strings.Search.Find_Token;
|
|
|
131
|
|
|
132 procedure Find_Token
|
|
|
133 (Source : String;
|
|
|
134 Set : Maps.Character_Set;
|
|
|
135 Test : Membership;
|
|
|
136 First : out Positive;
|
|
|
137 Last : out Natural)
|
|
|
138 renames Ada.Strings.Search.Find_Token;
|
|
|
139
|
|
|
140 ---------
|
|
|
141 -- "*" --
|
|
|
142 ---------
|
|
|
143
|
|
|
144 function "*"
|
|
|
145 (Left : Natural;
|
|
|
146 Right : Character) return String
|
|
|
147 is
|
|
|
148 Result : String (1 .. Left);
|
|
|
149
|
|
|
150 begin
|
|
|
151 for J in Result'Range loop
|
|
|
152 Result (J) := Right;
|
|
|
153 end loop;
|
|
|
154
|
|
|
155 return Result;
|
|
|
156 end "*";
|
|
|
157
|
|
|
158 function "*"
|
|
|
159 (Left : Natural;
|
|
|
160 Right : String) return String
|
|
|
161 is
|
|
|
162 Result : String (1 .. Left * Right'Length);
|
|
|
163 Ptr : Integer := 1;
|
|
|
164
|
|
|
165 begin
|
|
|
166 for J in 1 .. Left loop
|
|
|
167 Result (Ptr .. Ptr + Right'Length - 1) := Right;
|
|
|
168 Ptr := Ptr + Right'Length;
|
|
|
169 end loop;
|
|
|
170
|
|
|
171 return Result;
|
|
|
172 end "*";
|
|
|
173
|
|
|
174 ------------
|
|
|
175 -- Delete --
|
|
|
176 ------------
|
|
|
177
|
|
|
178 function Delete
|
|
|
179 (Source : String;
|
|
|
180 From : Positive;
|
|
|
181 Through : Natural) return String
|
|
|
182 is
|
|
|
183 begin
|
|
|
184 if From > Through then
|
|
|
185 declare
|
|
|
186 subtype Result_Type is String (1 .. Source'Length);
|
|
|
187
|
|
|
188 begin
|
|
|
189 return Result_Type (Source);
|
|
|
190 end;
|
|
|
191
|
|
|
192 elsif From not in Source'Range
|
|
|
193 or else Through > Source'Last
|
|
|
194 then
|
|
145
|
195 -- In most cases this raises an exception, but the case of deleting
|
|
|
196 -- a null string at the end of the current one is a special-case, and
|
|
|
197 -- reflects the equivalence with Replace_String (RM A.4.3 (86/3)).
|
|
|
198
|
|
|
199 if From = Source'Last + 1 and then From = Through then
|
|
|
200 return Source;
|
|
|
201 else
|
|
|
202 raise Index_Error;
|
|
|
203 end if;
|
|
111
|
204
|
|
|
205 else
|
|
|
206 declare
|
|
|
207 Front : constant Integer := From - Source'First;
|
|
|
208 Result : String (1 .. Source'Length - (Through - From + 1));
|
|
|
209
|
|
|
210 begin
|
|
|
211 Result (1 .. Front) :=
|
|
|
212 Source (Source'First .. From - 1);
|
|
|
213 Result (Front + 1 .. Result'Last) :=
|
|
|
214 Source (Through + 1 .. Source'Last);
|
|
|
215
|
|
|
216 return Result;
|
|
|
217 end;
|
|
|
218 end if;
|
|
|
219 end Delete;
|
|
|
220
|
|
|
221 procedure Delete
|
|
|
222 (Source : in out String;
|
|
|
223 From : Positive;
|
|
|
224 Through : Natural;
|
|
|
225 Justify : Alignment := Left;
|
|
|
226 Pad : Character := Space)
|
|
|
227 is
|
|
|
228 begin
|
|
|
229 Move (Source => Delete (Source, From, Through),
|
|
|
230 Target => Source,
|
|
|
231 Justify => Justify,
|
|
|
232 Pad => Pad);
|
|
|
233 end Delete;
|
|
|
234
|
|
|
235 ----------
|
|
|
236 -- Head --
|
|
|
237 ----------
|
|
|
238
|
|
|
239 function Head
|
|
|
240 (Source : String;
|
|
|
241 Count : Natural;
|
|
|
242 Pad : Character := Space) return String
|
|
|
243 is
|
|
|
244 subtype Result_Type is String (1 .. Count);
|
|
|
245
|
|
|
246 begin
|
|
|
247 if Count < Source'Length then
|
|
|
248 return
|
|
|
249 Result_Type (Source (Source'First .. Source'First + Count - 1));
|
|
|
250
|
|
|
251 else
|
|
|
252 declare
|
|
|
253 Result : Result_Type;
|
|
|
254
|
|
|
255 begin
|
|
|
256 Result (1 .. Source'Length) := Source;
|
|
|
257
|
|
|
258 for J in Source'Length + 1 .. Count loop
|
|
|
259 Result (J) := Pad;
|
|
|
260 end loop;
|
|
|
261
|
|
|
262 return Result;
|
|
|
263 end;
|
|
|
264 end if;
|
|
|
265 end Head;
|
|
|
266
|
|
|
267 procedure Head
|
|
|
268 (Source : in out String;
|
|
|
269 Count : Natural;
|
|
|
270 Justify : Alignment := Left;
|
|
|
271 Pad : Character := Space)
|
|
|
272 is
|
|
|
273 begin
|
|
|
274 Move (Source => Head (Source, Count, Pad),
|
|
|
275 Target => Source,
|
|
|
276 Drop => Error,
|
|
|
277 Justify => Justify,
|
|
|
278 Pad => Pad);
|
|
|
279 end Head;
|
|
|
280
|
|
|
281 ------------
|
|
|
282 -- Insert --
|
|
|
283 ------------
|
|
|
284
|
|
|
285 function Insert
|
|
|
286 (Source : String;
|
|
|
287 Before : Positive;
|
|
|
288 New_Item : String) return String
|
|
|
289 is
|
|
|
290 Result : String (1 .. Source'Length + New_Item'Length);
|
|
|
291 Front : constant Integer := Before - Source'First;
|
|
|
292
|
|
|
293 begin
|
|
|
294 if Before not in Source'First .. Source'Last + 1 then
|
|
|
295 raise Index_Error;
|
|
|
296 end if;
|
|
|
297
|
|
|
298 Result (1 .. Front) :=
|
|
|
299 Source (Source'First .. Before - 1);
|
|
|
300 Result (Front + 1 .. Front + New_Item'Length) :=
|
|
|
301 New_Item;
|
|
|
302 Result (Front + New_Item'Length + 1 .. Result'Last) :=
|
|
|
303 Source (Before .. Source'Last);
|
|
|
304
|
|
|
305 return Result;
|
|
|
306 end Insert;
|
|
|
307
|
|
|
308 procedure Insert
|
|
|
309 (Source : in out String;
|
|
|
310 Before : Positive;
|
|
|
311 New_Item : String;
|
|
|
312 Drop : Truncation := Error)
|
|
|
313 is
|
|
|
314 begin
|
|
|
315 Move (Source => Insert (Source, Before, New_Item),
|
|
|
316 Target => Source,
|
|
|
317 Drop => Drop);
|
|
|
318 end Insert;
|
|
|
319
|
|
|
320 ----------
|
|
|
321 -- Move --
|
|
|
322 ----------
|
|
|
323
|
|
|
324 procedure Move
|
|
|
325 (Source : String;
|
|
|
326 Target : out String;
|
|
|
327 Drop : Truncation := Error;
|
|
|
328 Justify : Alignment := Left;
|
|
|
329 Pad : Character := Space)
|
|
|
330 is
|
|
|
331 Sfirst : constant Integer := Source'First;
|
|
|
332 Slast : constant Integer := Source'Last;
|
|
|
333 Slength : constant Integer := Source'Length;
|
|
|
334
|
|
|
335 Tfirst : constant Integer := Target'First;
|
|
|
336 Tlast : constant Integer := Target'Last;
|
|
|
337 Tlength : constant Integer := Target'Length;
|
|
|
338
|
|
|
339 function Is_Padding (Item : String) return Boolean;
|
|
|
340 -- Check if Item is all Pad characters, return True if so, False if not
|
|
|
341
|
|
|
342 function Is_Padding (Item : String) return Boolean is
|
|
|
343 begin
|
|
|
344 for J in Item'Range loop
|
|
|
345 if Item (J) /= Pad then
|
|
|
346 return False;
|
|
|
347 end if;
|
|
|
348 end loop;
|
|
|
349
|
|
|
350 return True;
|
|
|
351 end Is_Padding;
|
|
|
352
|
|
|
353 -- Start of processing for Move
|
|
|
354
|
|
|
355 begin
|
|
|
356 if Slength = Tlength then
|
|
|
357 Target := Source;
|
|
|
358
|
|
|
359 elsif Slength > Tlength then
|
|
|
360 case Drop is
|
|
|
361 when Left =>
|
|
|
362 Target := Source (Slast - Tlength + 1 .. Slast);
|
|
|
363
|
|
|
364 when Right =>
|
|
|
365 Target := Source (Sfirst .. Sfirst + Tlength - 1);
|
|
|
366
|
|
|
367 when Error =>
|
|
|
368 case Justify is
|
|
|
369 when Left =>
|
|
|
370 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
|
|
|
371 Target :=
|
|
|
372 Source (Sfirst .. Sfirst + Target'Length - 1);
|
|
|
373 else
|
|
|
374 raise Length_Error;
|
|
|
375 end if;
|
|
|
376
|
|
|
377 when Right =>
|
|
|
378 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
|
|
|
379 Target := Source (Slast - Tlength + 1 .. Slast);
|
|
|
380 else
|
|
|
381 raise Length_Error;
|
|
|
382 end if;
|
|
|
383
|
|
|
384 when Center =>
|
|
|
385 raise Length_Error;
|
|
|
386 end case;
|
|
|
387 end case;
|
|
|
388
|
|
|
389 -- Source'Length < Target'Length
|
|
|
390
|
|
|
391 else
|
|
|
392 case Justify is
|
|
|
393 when Left =>
|
|
|
394 Target (Tfirst .. Tfirst + Slength - 1) := Source;
|
|
|
395
|
|
|
396 for I in Tfirst + Slength .. Tlast loop
|
|
|
397 Target (I) := Pad;
|
|
|
398 end loop;
|
|
|
399
|
|
|
400 when Right =>
|
|
|
401 for I in Tfirst .. Tlast - Slength loop
|
|
|
402 Target (I) := Pad;
|
|
|
403 end loop;
|
|
|
404
|
|
|
405 Target (Tlast - Slength + 1 .. Tlast) := Source;
|
|
|
406
|
|
|
407 when Center =>
|
|
|
408 declare
|
|
|
409 Front_Pad : constant Integer := (Tlength - Slength) / 2;
|
|
|
410 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
|
|
|
411
|
|
|
412 begin
|
|
|
413 for I in Tfirst .. Tfirst_Fpad - 1 loop
|
|
|
414 Target (I) := Pad;
|
|
|
415 end loop;
|
|
|
416
|
|
|
417 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
|
|
|
418
|
|
|
419 for I in Tfirst_Fpad + Slength .. Tlast loop
|
|
|
420 Target (I) := Pad;
|
|
|
421 end loop;
|
|
|
422 end;
|
|
|
423 end case;
|
|
|
424 end if;
|
|
|
425 end Move;
|
|
|
426
|
|
|
427 ---------------
|
|
|
428 -- Overwrite --
|
|
|
429 ---------------
|
|
|
430
|
|
|
431 function Overwrite
|
|
|
432 (Source : String;
|
|
|
433 Position : Positive;
|
|
|
434 New_Item : String) return String
|
|
|
435 is
|
|
|
436 begin
|
|
|
437 if Position not in Source'First .. Source'Last + 1 then
|
|
|
438 raise Index_Error;
|
|
|
439 end if;
|
|
|
440
|
|
|
441 declare
|
|
|
442 Result_Length : constant Natural :=
|
|
|
443 Integer'Max
|
|
|
444 (Source'Length,
|
|
|
445 Position - Source'First + New_Item'Length);
|
|
|
446
|
|
|
447 Result : String (1 .. Result_Length);
|
|
|
448 Front : constant Integer := Position - Source'First;
|
|
|
449
|
|
|
450 begin
|
|
|
451 Result (1 .. Front) :=
|
|
|
452 Source (Source'First .. Position - 1);
|
|
|
453 Result (Front + 1 .. Front + New_Item'Length) :=
|
|
|
454 New_Item;
|
|
|
455 Result (Front + New_Item'Length + 1 .. Result'Length) :=
|
|
|
456 Source (Position + New_Item'Length .. Source'Last);
|
|
|
457 return Result;
|
|
|
458 end;
|
|
|
459 end Overwrite;
|
|
|
460
|
|
|
461 procedure Overwrite
|
|
|
462 (Source : in out String;
|
|
|
463 Position : Positive;
|
|
|
464 New_Item : String;
|
|
|
465 Drop : Truncation := Right)
|
|
|
466 is
|
|
|
467 begin
|
|
|
468 Move (Source => Overwrite (Source, Position, New_Item),
|
|
|
469 Target => Source,
|
|
|
470 Drop => Drop);
|
|
|
471 end Overwrite;
|
|
|
472
|
|
|
473 -------------------
|
|
|
474 -- Replace_Slice --
|
|
|
475 -------------------
|
|
|
476
|
|
|
477 function Replace_Slice
|
|
|
478 (Source : String;
|
|
|
479 Low : Positive;
|
|
|
480 High : Natural;
|
|
|
481 By : String) return String
|
|
|
482 is
|
|
|
483 begin
|
|
|
484 if Low > Source'Last + 1 or else High < Source'First - 1 then
|
|
|
485 raise Index_Error;
|
|
|
486 end if;
|
|
|
487
|
|
|
488 if High >= Low then
|
|
|
489 declare
|
|
|
490 Front_Len : constant Integer :=
|
|
|
491 Integer'Max (0, Low - Source'First);
|
|
|
492 -- Length of prefix of Source copied to result
|
|
|
493
|
|
|
494 Back_Len : constant Integer :=
|
|
|
495 Integer'Max (0, Source'Last - High);
|
|
|
496 -- Length of suffix of Source copied to result
|
|
|
497
|
|
|
498 Result_Length : constant Integer :=
|
|
|
499 Front_Len + By'Length + Back_Len;
|
|
|
500 -- Length of result
|
|
|
501
|
|
|
502 Result : String (1 .. Result_Length);
|
|
|
503
|
|
|
504 begin
|
|
|
505 Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
|
|
|
506 Result (Front_Len + 1 .. Front_Len + By'Length) := By;
|
|
|
507 Result (Front_Len + By'Length + 1 .. Result'Length) :=
|
|
|
508 Source (High + 1 .. Source'Last);
|
|
|
509 return Result;
|
|
|
510 end;
|
|
|
511
|
|
|
512 else
|
|
|
513 return Insert (Source, Before => Low, New_Item => By);
|
|
|
514 end if;
|
|
|
515 end Replace_Slice;
|
|
|
516
|
|
|
517 procedure Replace_Slice
|
|
|
518 (Source : in out String;
|
|
|
519 Low : Positive;
|
|
|
520 High : Natural;
|
|
|
521 By : String;
|
|
|
522 Drop : Truncation := Error;
|
|
|
523 Justify : Alignment := Left;
|
|
|
524 Pad : Character := Space)
|
|
|
525 is
|
|
|
526 begin
|
|
|
527 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
|
|
|
528 end Replace_Slice;
|
|
|
529
|
|
|
530 ----------
|
|
|
531 -- Tail --
|
|
|
532 ----------
|
|
|
533
|
|
|
534 function Tail
|
|
|
535 (Source : String;
|
|
|
536 Count : Natural;
|
|
|
537 Pad : Character := Space) return String
|
|
|
538 is
|
|
|
539 subtype Result_Type is String (1 .. Count);
|
|
|
540
|
|
|
541 begin
|
|
|
542 if Count < Source'Length then
|
|
|
543 return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
|
|
|
544
|
|
|
545 -- Pad on left
|
|
|
546
|
|
|
547 else
|
|
|
548 declare
|
|
|
549 Result : Result_Type;
|
|
|
550
|
|
|
551 begin
|
|
|
552 for J in 1 .. Count - Source'Length loop
|
|
|
553 Result (J) := Pad;
|
|
|
554 end loop;
|
|
|
555
|
|
|
556 Result (Count - Source'Length + 1 .. Count) := Source;
|
|
|
557 return Result;
|
|
|
558 end;
|
|
|
559 end if;
|
|
|
560 end Tail;
|
|
|
561
|
|
|
562 procedure Tail
|
|
|
563 (Source : in out String;
|
|
|
564 Count : Natural;
|
|
|
565 Justify : Alignment := Left;
|
|
|
566 Pad : Character := Space)
|
|
|
567 is
|
|
|
568 begin
|
|
|
569 Move (Source => Tail (Source, Count, Pad),
|
|
|
570 Target => Source,
|
|
|
571 Drop => Error,
|
|
|
572 Justify => Justify,
|
|
|
573 Pad => Pad);
|
|
|
574 end Tail;
|
|
|
575
|
|
|
576 ---------------
|
|
|
577 -- Translate --
|
|
|
578 ---------------
|
|
|
579
|
|
|
580 function Translate
|
|
|
581 (Source : String;
|
|
|
582 Mapping : Maps.Character_Mapping) return String
|
|
|
583 is
|
|
|
584 Result : String (1 .. Source'Length);
|
|
|
585
|
|
|
586 begin
|
|
|
587 for J in Source'Range loop
|
|
|
588 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
|
|
|
589 end loop;
|
|
|
590
|
|
|
591 return Result;
|
|
|
592 end Translate;
|
|
|
593
|
|
|
594 procedure Translate
|
|
|
595 (Source : in out String;
|
|
|
596 Mapping : Maps.Character_Mapping)
|
|
|
597 is
|
|
|
598 begin
|
|
|
599 for J in Source'Range loop
|
|
|
600 Source (J) := Value (Mapping, Source (J));
|
|
|
601 end loop;
|
|
|
602 end Translate;
|
|
|
603
|
|
|
604 function Translate
|
|
|
605 (Source : String;
|
|
|
606 Mapping : Maps.Character_Mapping_Function) return String
|
|
|
607 is
|
|
|
608 Result : String (1 .. Source'Length);
|
|
|
609 pragma Unsuppress (Access_Check);
|
|
|
610
|
|
|
611 begin
|
|
|
612 for J in Source'Range loop
|
|
|
613 Result (J - (Source'First - 1)) := Mapping.all (Source (J));
|
|
|
614 end loop;
|
|
|
615
|
|
|
616 return Result;
|
|
|
617 end Translate;
|
|
|
618
|
|
|
619 procedure Translate
|
|
|
620 (Source : in out String;
|
|
|
621 Mapping : Maps.Character_Mapping_Function)
|
|
|
622 is
|
|
|
623 pragma Unsuppress (Access_Check);
|
|
|
624 begin
|
|
|
625 for J in Source'Range loop
|
|
|
626 Source (J) := Mapping.all (Source (J));
|
|
|
627 end loop;
|
|
|
628 end Translate;
|
|
|
629
|
|
|
630 ----------
|
|
|
631 -- Trim --
|
|
|
632 ----------
|
|
|
633
|
|
|
634 function Trim
|
|
|
635 (Source : String;
|
|
|
636 Side : Trim_End) return String
|
|
|
637 is
|
|
|
638 begin
|
|
|
639 case Side is
|
|
|
640 when Strings.Left =>
|
|
|
641 declare
|
|
|
642 Low : constant Natural := Index_Non_Blank (Source, Forward);
|
|
|
643 begin
|
|
|
644 -- All blanks case
|
|
|
645
|
|
|
646 if Low = 0 then
|
|
|
647 return "";
|
|
|
648 end if;
|
|
|
649
|
|
|
650 declare
|
|
|
651 subtype Result_Type is String (1 .. Source'Last - Low + 1);
|
|
|
652 begin
|
|
|
653 return Result_Type (Source (Low .. Source'Last));
|
|
|
654 end;
|
|
|
655 end;
|
|
|
656
|
|
|
657 when Strings.Right =>
|
|
|
658 declare
|
|
|
659 High : constant Natural := Index_Non_Blank (Source, Backward);
|
|
|
660 begin
|
|
|
661 -- All blanks case
|
|
|
662
|
|
|
663 if High = 0 then
|
|
|
664 return "";
|
|
|
665 end if;
|
|
|
666
|
|
|
667 declare
|
|
|
668 subtype Result_Type is String (1 .. High - Source'First + 1);
|
|
|
669 begin
|
|
|
670 return Result_Type (Source (Source'First .. High));
|
|
|
671 end;
|
|
|
672 end;
|
|
|
673
|
|
|
674 when Strings.Both =>
|
|
|
675 declare
|
|
|
676 Low : constant Natural := Index_Non_Blank (Source, Forward);
|
|
|
677 begin
|
|
|
678 -- All blanks case
|
|
|
679
|
|
|
680 if Low = 0 then
|
|
|
681 return "";
|
|
|
682 end if;
|
|
|
683
|
|
|
684 declare
|
|
|
685 High : constant Natural :=
|
|
|
686 Index_Non_Blank (Source, Backward);
|
|
|
687 subtype Result_Type is String (1 .. High - Low + 1);
|
|
|
688 begin
|
|
|
689 return Result_Type (Source (Low .. High));
|
|
|
690 end;
|
|
|
691 end;
|
|
|
692 end case;
|
|
|
693 end Trim;
|
|
|
694
|
|
|
695 procedure Trim
|
|
|
696 (Source : in out String;
|
|
|
697 Side : Trim_End;
|
|
|
698 Justify : Alignment := Left;
|
|
|
699 Pad : Character := Space)
|
|
|
700 is
|
|
|
701 begin
|
|
|
702 Move (Trim (Source, Side),
|
|
|
703 Source,
|
|
|
704 Justify => Justify,
|
|
|
705 Pad => Pad);
|
|
|
706 end Trim;
|
|
|
707
|
|
|
708 function Trim
|
|
|
709 (Source : String;
|
|
|
710 Left : Maps.Character_Set;
|
|
|
711 Right : Maps.Character_Set) return String
|
|
|
712 is
|
|
|
713 High, Low : Integer;
|
|
|
714
|
|
|
715 begin
|
|
|
716 Low := Index (Source, Set => Left, Test => Outside, Going => Forward);
|
|
|
717
|
|
|
718 -- Case where source comprises only characters in Left
|
|
|
719
|
|
|
720 if Low = 0 then
|
|
|
721 return "";
|
|
|
722 end if;
|
|
|
723
|
|
|
724 High :=
|
|
|
725 Index (Source, Set => Right, Test => Outside, Going => Backward);
|
|
|
726
|
|
|
727 -- Case where source comprises only characters in Right
|
|
|
728
|
|
|
729 if High = 0 then
|
|
|
730 return "";
|
|
|
731 end if;
|
|
|
732
|
|
|
733 declare
|
|
|
734 subtype Result_Type is String (1 .. High - Low + 1);
|
|
|
735
|
|
|
736 begin
|
|
|
737 return Result_Type (Source (Low .. High));
|
|
|
738 end;
|
|
|
739 end Trim;
|
|
|
740
|
|
|
741 procedure Trim
|
|
|
742 (Source : in out String;
|
|
|
743 Left : Maps.Character_Set;
|
|
|
744 Right : Maps.Character_Set;
|
|
|
745 Justify : Alignment := Strings.Left;
|
|
|
746 Pad : Character := Space)
|
|
|
747 is
|
|
|
748 begin
|
|
|
749 Move (Source => Trim (Source, Left, Right),
|
|
|
750 Target => Source,
|
|
|
751 Justify => Justify,
|
|
|
752 Pad => Pad);
|
|
|
753 end Trim;
|
|
|
754
|
|
|
755 end Ada.Strings.Fixed;
|
