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