annotate gcc/ada/libgnat/a-strsea.adb @ 111:04ced10e8804

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