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-- 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 38with Ada.Strings.Maps; use Ada.Strings.Maps; 39with System; use System; 40 41package 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 645end Ada.Strings.Search; 646