File : a-strsea.adb
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-2015, 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 -- --
19 -- --
20 -- --
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;