Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-stwifi.adb @ 111:04ced10e8804

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