Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/a-strsea.adb @ 111:04ced10e8804
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 . S E A R C H -- | |
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 -- Note: This code is derived from the ADAR.CSH public domain Ada 83 | |
33 -- versions of the Appendix C string handling packages (code extracted | |
34 -- from Ada.Strings.Fixed). A significant change is that we optimize the | |
35 -- case of identity mappings for Count and Index, and also Index_Non_Blank | |
36 -- is specialized (rather than using the general Index routine). | |
37 | |
38 with Ada.Strings.Maps; use Ada.Strings.Maps; | |
39 with System; use System; | |
40 | |
41 package body Ada.Strings.Search is | |
42 | |
43 ----------------------- | |
44 -- Local Subprograms -- | |
45 ----------------------- | |
46 | |
47 function Belongs | |
48 (Element : Character; | |
49 Set : Maps.Character_Set; | |
50 Test : Membership) return Boolean; | |
51 pragma Inline (Belongs); | |
52 -- Determines if the given element is in (Test = Inside) or not in | |
53 -- (Test = Outside) the given character set. | |
54 | |
55 ------------- | |
56 -- Belongs -- | |
57 ------------- | |
58 | |
59 function Belongs | |
60 (Element : Character; | |
61 Set : Maps.Character_Set; | |
62 Test : Membership) return Boolean | |
63 is | |
64 begin | |
65 if Test = Inside then | |
66 return Is_In (Element, Set); | |
67 else | |
68 return not Is_In (Element, Set); | |
69 end if; | |
70 end Belongs; | |
71 | |
72 ----------- | |
73 -- Count -- | |
74 ----------- | |
75 | |
76 function Count | |
77 (Source : String; | |
78 Pattern : String; | |
79 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural | |
80 is | |
81 PL1 : constant Integer := Pattern'Length - 1; | |
82 Num : Natural; | |
83 Ind : Natural; | |
84 Cur : Natural; | |
85 | |
86 begin | |
87 if Pattern = "" then | |
88 raise Pattern_Error; | |
89 end if; | |
90 | |
91 Num := 0; | |
92 Ind := Source'First; | |
93 | |
94 -- Unmapped case | |
95 | |
96 if Mapping'Address = Maps.Identity'Address then | |
97 while Ind <= Source'Last - PL1 loop | |
98 if Pattern = Source (Ind .. Ind + PL1) then | |
99 Num := Num + 1; | |
100 Ind := Ind + Pattern'Length; | |
101 else | |
102 Ind := Ind + 1; | |
103 end if; | |
104 end loop; | |
105 | |
106 -- Mapped case | |
107 | |
108 else | |
109 while Ind <= Source'Last - PL1 loop | |
110 Cur := Ind; | |
111 for K in Pattern'Range loop | |
112 if Pattern (K) /= Value (Mapping, Source (Cur)) then | |
113 Ind := Ind + 1; | |
114 goto Cont; | |
115 else | |
116 Cur := Cur + 1; | |
117 end if; | |
118 end loop; | |
119 | |
120 Num := Num + 1; | |
121 Ind := Ind + Pattern'Length; | |
122 | |
123 <<Cont>> | |
124 null; | |
125 end loop; | |
126 end if; | |
127 | |
128 -- Return result | |
129 | |
130 return Num; | |
131 end Count; | |
132 | |
133 function Count | |
134 (Source : String; | |
135 Pattern : String; | |
136 Mapping : Maps.Character_Mapping_Function) return Natural | |
137 is | |
138 PL1 : constant Integer := Pattern'Length - 1; | |
139 Num : Natural; | |
140 Ind : Natural; | |
141 Cur : Natural; | |
142 | |
143 begin | |
144 if Pattern = "" then | |
145 raise Pattern_Error; | |
146 end if; | |
147 | |
148 -- Check for null pointer in case checks are off | |
149 | |
150 if Mapping = null then | |
151 raise Constraint_Error; | |
152 end if; | |
153 | |
154 Num := 0; | |
155 Ind := Source'First; | |
156 while Ind <= Source'Last - PL1 loop | |
157 Cur := Ind; | |
158 for K in Pattern'Range loop | |
159 if Pattern (K) /= Mapping (Source (Cur)) then | |
160 Ind := Ind + 1; | |
161 goto Cont; | |
162 else | |
163 Cur := Cur + 1; | |
164 end if; | |
165 end loop; | |
166 | |
167 Num := Num + 1; | |
168 Ind := Ind + Pattern'Length; | |
169 | |
170 <<Cont>> | |
171 null; | |
172 end loop; | |
173 | |
174 return Num; | |
175 end Count; | |
176 | |
177 function Count | |
178 (Source : String; | |
179 Set : Maps.Character_Set) return Natural | |
180 is | |
181 N : Natural := 0; | |
182 | |
183 begin | |
184 for J in Source'Range loop | |
185 if Is_In (Source (J), Set) then | |
186 N := N + 1; | |
187 end if; | |
188 end loop; | |
189 | |
190 return N; | |
191 end Count; | |
192 | |
193 ---------------- | |
194 -- Find_Token -- | |
195 ---------------- | |
196 | |
197 procedure Find_Token | |
198 (Source : String; | |
199 Set : Maps.Character_Set; | |
200 From : Positive; | |
201 Test : Membership; | |
202 First : out Positive; | |
203 Last : out Natural) | |
204 is | |
205 begin | |
206 -- AI05-031: Raise Index error if Source non-empty and From not in range | |
207 | |
208 if Source'Length /= 0 and then From not in Source'Range then | |
209 raise Index_Error; | |
210 end if; | |
211 | |
212 -- If Source is the empty string, From may still be out of its | |
213 -- range. The following ensures that in all cases there is no | |
214 -- possible erroneous access to a non-existing character. | |
215 | |
216 for J in Integer'Max (From, Source'First) .. Source'Last loop | |
217 if Belongs (Source (J), Set, Test) then | |
218 First := J; | |
219 | |
220 for K in J + 1 .. Source'Last loop | |
221 if not Belongs (Source (K), Set, Test) then | |
222 Last := K - 1; | |
223 return; | |
224 end if; | |
225 end loop; | |
226 | |
227 -- Here if J indexes first char of token, and all chars after J | |
228 -- are in the token. | |
229 | |
230 Last := Source'Last; | |
231 return; | |
232 end if; | |
233 end loop; | |
234 | |
235 -- Here if no token found | |
236 | |
237 First := From; | |
238 Last := 0; | |
239 end Find_Token; | |
240 | |
241 procedure Find_Token | |
242 (Source : String; | |
243 Set : Maps.Character_Set; | |
244 Test : Membership; | |
245 First : out Positive; | |
246 Last : out Natural) | |
247 is | |
248 begin | |
249 for J in Source'Range loop | |
250 if Belongs (Source (J), Set, Test) then | |
251 First := J; | |
252 | |
253 for K in J + 1 .. Source'Last loop | |
254 if not Belongs (Source (K), Set, Test) then | |
255 Last := K - 1; | |
256 return; | |
257 end if; | |
258 end loop; | |
259 | |
260 -- Here if J indexes first char of token, and all chars after J | |
261 -- are in the token. | |
262 | |
263 Last := Source'Last; | |
264 return; | |
265 end if; | |
266 end loop; | |
267 | |
268 -- Here if no token found | |
269 | |
270 -- RM 2005 A.4.3 (68/1) specifies that an exception must be raised if | |
271 -- Source'First is not positive and is assigned to First. Formulation | |
272 -- is slightly different in RM 2012, but the intent seems similar, so | |
273 -- we check explicitly for that condition. | |
274 | |
275 if Source'First not in Positive then | |
276 raise Constraint_Error; | |
277 | |
278 else | |
279 First := Source'First; | |
280 Last := 0; | |
281 end if; | |
282 end Find_Token; | |
283 | |
284 ----------- | |
285 -- Index -- | |
286 ----------- | |
287 | |
288 function Index | |
289 (Source : String; | |
290 Pattern : String; | |
291 Going : Direction := Forward; | |
292 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural | |
293 is | |
294 PL1 : constant Integer := Pattern'Length - 1; | |
295 Cur : Natural; | |
296 | |
297 Ind : Integer; | |
298 -- Index for start of match check. This can be negative if the pattern | |
299 -- length is greater than the string length, which is why this variable | |
300 -- is Integer instead of Natural. In this case, the search loops do not | |
301 -- execute at all, so this Ind value is never used. | |
302 | |
303 begin | |
304 if Pattern = "" then | |
305 raise Pattern_Error; | |
306 end if; | |
307 | |
308 -- Forwards case | |
309 | |
310 if Going = Forward then | |
311 Ind := Source'First; | |
312 | |
313 -- Unmapped forward case | |
314 | |
315 if Mapping'Address = Maps.Identity'Address then | |
316 for J in 1 .. Source'Length - PL1 loop | |
317 if Pattern = Source (Ind .. Ind + PL1) then | |
318 return Ind; | |
319 else | |
320 Ind := Ind + 1; | |
321 end if; | |
322 end loop; | |
323 | |
324 -- Mapped forward case | |
325 | |
326 else | |
327 for J in 1 .. Source'Length - PL1 loop | |
328 Cur := Ind; | |
329 | |
330 for K in Pattern'Range loop | |
331 if Pattern (K) /= Value (Mapping, Source (Cur)) then | |
332 goto Cont1; | |
333 else | |
334 Cur := Cur + 1; | |
335 end if; | |
336 end loop; | |
337 | |
338 return Ind; | |
339 | |
340 <<Cont1>> | |
341 Ind := Ind + 1; | |
342 end loop; | |
343 end if; | |
344 | |
345 -- Backwards case | |
346 | |
347 else | |
348 -- Unmapped backward case | |
349 | |
350 Ind := Source'Last - PL1; | |
351 | |
352 if Mapping'Address = Maps.Identity'Address then | |
353 for J in reverse 1 .. Source'Length - PL1 loop | |
354 if Pattern = Source (Ind .. Ind + PL1) then | |
355 return Ind; | |
356 else | |
357 Ind := Ind - 1; | |
358 end if; | |
359 end loop; | |
360 | |
361 -- Mapped backward case | |
362 | |
363 else | |
364 for J in reverse 1 .. Source'Length - PL1 loop | |
365 Cur := Ind; | |
366 | |
367 for K in Pattern'Range loop | |
368 if Pattern (K) /= Value (Mapping, Source (Cur)) then | |
369 goto Cont2; | |
370 else | |
371 Cur := Cur + 1; | |
372 end if; | |
373 end loop; | |
374 | |
375 return Ind; | |
376 | |
377 <<Cont2>> | |
378 Ind := Ind - 1; | |
379 end loop; | |
380 end if; | |
381 end if; | |
382 | |
383 -- Fall through if no match found. Note that the loops are skipped | |
384 -- completely in the case of the pattern being longer than the source. | |
385 | |
386 return 0; | |
387 end Index; | |
388 | |
389 function Index | |
390 (Source : String; | |
391 Pattern : String; | |
392 Going : Direction := Forward; | |
393 Mapping : Maps.Character_Mapping_Function) return Natural | |
394 is | |
395 PL1 : constant Integer := Pattern'Length - 1; | |
396 Ind : Natural; | |
397 Cur : Natural; | |
398 | |
399 begin | |
400 if Pattern = "" then | |
401 raise Pattern_Error; | |
402 end if; | |
403 | |
404 -- Check for null pointer in case checks are off | |
405 | |
406 if Mapping = null then | |
407 raise Constraint_Error; | |
408 end if; | |
409 | |
410 -- If Pattern longer than Source it can't be found | |
411 | |
412 if Pattern'Length > Source'Length then | |
413 return 0; | |
414 end if; | |
415 | |
416 -- Forwards case | |
417 | |
418 if Going = Forward then | |
419 Ind := Source'First; | |
420 for J in 1 .. Source'Length - PL1 loop | |
421 Cur := Ind; | |
422 | |
423 for K in Pattern'Range loop | |
424 if Pattern (K) /= Mapping.all (Source (Cur)) then | |
425 goto Cont1; | |
426 else | |
427 Cur := Cur + 1; | |
428 end if; | |
429 end loop; | |
430 | |
431 return Ind; | |
432 | |
433 <<Cont1>> | |
434 Ind := Ind + 1; | |
435 end loop; | |
436 | |
437 -- Backwards case | |
438 | |
439 else | |
440 Ind := Source'Last - PL1; | |
441 for J in reverse 1 .. Source'Length - PL1 loop | |
442 Cur := Ind; | |
443 | |
444 for K in Pattern'Range loop | |
445 if Pattern (K) /= Mapping.all (Source (Cur)) then | |
446 goto Cont2; | |
447 else | |
448 Cur := Cur + 1; | |
449 end if; | |
450 end loop; | |
451 | |
452 return Ind; | |
453 | |
454 <<Cont2>> | |
455 Ind := Ind - 1; | |
456 end loop; | |
457 end if; | |
458 | |
459 -- Fall through if no match found. Note that the loops are skipped | |
460 -- completely in the case of the pattern being longer than the source. | |
461 | |
462 return 0; | |
463 end Index; | |
464 | |
465 function Index | |
466 (Source : String; | |
467 Set : Maps.Character_Set; | |
468 Test : Membership := Inside; | |
469 Going : Direction := Forward) return Natural | |
470 is | |
471 begin | |
472 -- Forwards case | |
473 | |
474 if Going = Forward then | |
475 for J in Source'Range loop | |
476 if Belongs (Source (J), Set, Test) then | |
477 return J; | |
478 end if; | |
479 end loop; | |
480 | |
481 -- Backwards case | |
482 | |
483 else | |
484 for J in reverse Source'Range loop | |
485 if Belongs (Source (J), Set, Test) then | |
486 return J; | |
487 end if; | |
488 end loop; | |
489 end if; | |
490 | |
491 -- Fall through if no match | |
492 | |
493 return 0; | |
494 end Index; | |
495 | |
496 function Index | |
497 (Source : String; | |
498 Pattern : String; | |
499 From : Positive; | |
500 Going : Direction := Forward; | |
501 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural | |
502 is | |
503 begin | |
504 | |
505 -- AI05-056: If source is empty result is always zero | |
506 | |
507 if Source'Length = 0 then | |
508 return 0; | |
509 | |
510 elsif Going = Forward then | |
511 if From < Source'First then | |
512 raise Index_Error; | |
513 end if; | |
514 | |
515 return | |
516 Index (Source (From .. Source'Last), Pattern, Forward, Mapping); | |
517 | |
518 else | |
519 if From > Source'Last then | |
520 raise Index_Error; | |
521 end if; | |
522 | |
523 return | |
524 Index (Source (Source'First .. From), Pattern, Backward, Mapping); | |
525 end if; | |
526 end Index; | |
527 | |
528 function Index | |
529 (Source : String; | |
530 Pattern : String; | |
531 From : Positive; | |
532 Going : Direction := Forward; | |
533 Mapping : Maps.Character_Mapping_Function) return Natural | |
534 is | |
535 begin | |
536 | |
537 -- AI05-056: If source is empty result is always zero | |
538 | |
539 if Source'Length = 0 then | |
540 return 0; | |
541 | |
542 elsif Going = Forward then | |
543 if From < Source'First then | |
544 raise Index_Error; | |
545 end if; | |
546 | |
547 return Index | |
548 (Source (From .. Source'Last), Pattern, Forward, Mapping); | |
549 | |
550 else | |
551 if From > Source'Last then | |
552 raise Index_Error; | |
553 end if; | |
554 | |
555 return Index | |
556 (Source (Source'First .. From), Pattern, Backward, Mapping); | |
557 end if; | |
558 end Index; | |
559 | |
560 function Index | |
561 (Source : String; | |
562 Set : Maps.Character_Set; | |
563 From : Positive; | |
564 Test : Membership := Inside; | |
565 Going : Direction := Forward) return Natural | |
566 is | |
567 begin | |
568 | |
569 -- AI05-056 : if source is empty result is always 0. | |
570 | |
571 if Source'Length = 0 then | |
572 return 0; | |
573 | |
574 elsif Going = Forward then | |
575 if From < Source'First then | |
576 raise Index_Error; | |
577 end if; | |
578 | |
579 return | |
580 Index (Source (From .. Source'Last), Set, Test, Forward); | |
581 | |
582 else | |
583 if From > Source'Last then | |
584 raise Index_Error; | |
585 end if; | |
586 | |
587 return | |
588 Index (Source (Source'First .. From), Set, Test, Backward); | |
589 end if; | |
590 end Index; | |
591 | |
592 --------------------- | |
593 -- Index_Non_Blank -- | |
594 --------------------- | |
595 | |
596 function Index_Non_Blank | |
597 (Source : String; | |
598 Going : Direction := Forward) return Natural | |
599 is | |
600 begin | |
601 if Going = Forward then | |
602 for J in Source'Range loop | |
603 if Source (J) /= ' ' then | |
604 return J; | |
605 end if; | |
606 end loop; | |
607 | |
608 else -- Going = Backward | |
609 for J in reverse Source'Range loop | |
610 if Source (J) /= ' ' then | |
611 return J; | |
612 end if; | |
613 end loop; | |
614 end if; | |
615 | |
616 -- Fall through if no match | |
617 | |
618 return 0; | |
619 end Index_Non_Blank; | |
620 | |
621 function Index_Non_Blank | |
622 (Source : String; | |
623 From : Positive; | |
624 Going : Direction := Forward) return Natural | |
625 is | |
626 begin | |
627 if Going = Forward then | |
628 if From < Source'First then | |
629 raise Index_Error; | |
630 end if; | |
631 | |
632 return | |
633 Index_Non_Blank (Source (From .. Source'Last), Forward); | |
634 | |
635 else | |
636 if From > Source'Last then | |
637 raise Index_Error; | |
638 end if; | |
639 | |
640 return | |
641 Index_Non_Blank (Source (Source'First .. From), Backward); | |
642 end if; | |
643 end Index_Non_Blank; | |
644 | |
645 end Ada.Strings.Search; |