gcc/ada/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 -- 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       for J in From .. Source'Last loop
 213          if Belongs (Source (J), Set, Test) then
 214             First := J;
 215
 216             for K in J + 1 .. Source'Last loop
 217                if not Belongs (Source (K), Set, Test) then
 218                   Last := K - 1;
 219                   return;
 220                end if;
 221             end loop;
 222
 223             --  Here if J indexes first char of token, and all chars after J
 224             --  are in the token.
 225
 226             Last := Source'Last;
 227             return;
 228          end if;
 229       end loop;
 230
 231       --  Here if no token found
 232
 233       First := From;
 234       Last  := 0;
 235    end Find_Token;
 236
 237    procedure Find_Token
 238      (Source : String;
 239       Set    : Maps.Character_Set;
 240       Test   : Membership;
 241       First  : out Positive;
 242       Last   : out Natural)
 243    is
 244    begin
 245       for J in Source'Range loop
 246          if Belongs (Source (J), Set, Test) then
 247             First := J;
 248
 249             for K in J + 1 .. Source'Last loop
 250                if not Belongs (Source (K), Set, Test) then
 251                   Last := K - 1;
 252                   return;
 253                end if;
 254             end loop;
 255
 256             --  Here if J indexes first char of token, and all chars after J
 257             --  are in the token.
 258
 259             Last := Source'Last;
 260             return;
 261          end if;
 262       end loop;
 263
 264       --  Here if no token found
 265
 266       --  RM 2005 A.4.3 (68/1) specifies that an exception must be raised if
 267       --  Source'First is not positive and is assigned to First. Formulation
 268       --  is slightly different in RM 2012, but the intent seems similar, so
 269       --  we check explicitly for that condition.
 270
 271       if Source'First not in Positive then
 272          raise Constraint_Error;
 273
 274       else
 275          First := Source'First;
 276          Last  := 0;
 277       end if;
 278    end Find_Token;
 279
 280    -----------
 281    -- Index --
 282    -----------
 283
 284    function Index
 285      (Source  : String;
 286       Pattern : String;
 287       Going   : Direction := Forward;
 288       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 289    is
 290       PL1 : constant Integer := Pattern'Length - 1;
 291       Cur : Natural;
 292
 293       Ind : Integer;
 294       --  Index for start of match check. This can be negative if the pattern
 295       --  length is greater than the string length, which is why this variable
 296       --  is Integer instead of Natural. In this case, the search loops do not
 297       --  execute at all, so this Ind value is never used.
 298
 299    begin
 300       if Pattern = "" then
 301          raise Pattern_Error;
 302       end if;
 303
 304       --  Forwards case
 305
 306       if Going = Forward then
 307          Ind := Source'First;
 308
 309          --  Unmapped forward case
 310
 311          if Mapping'Address = Maps.Identity'Address then
 312             for J in 1 .. Source'Length - PL1 loop
 313                if Pattern = Source (Ind .. Ind + PL1) then
 314                   return Ind;
 315                else
 316                   Ind := Ind + 1;
 317                end if;
 318             end loop;
 319
 320          --  Mapped forward case
 321
 322          else
 323             for J in 1 .. Source'Length - PL1 loop
 324                Cur := Ind;
 325
 326                for K in Pattern'Range loop
 327                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 328                      goto Cont1;
 329                   else
 330                      Cur := Cur + 1;
 331                   end if;
 332                end loop;
 333
 334                return Ind;
 335
 336             <<Cont1>>
 337                Ind := Ind + 1;
 338             end loop;
 339          end if;
 340
 341       --  Backwards case
 342
 343       else
 344          --  Unmapped backward case
 345
 346          Ind := Source'Last - PL1;
 347
 348          if Mapping'Address = Maps.Identity'Address then
 349             for J in reverse 1 .. Source'Length - PL1 loop
 350                if Pattern = Source (Ind .. Ind + PL1) then
 351                   return Ind;
 352                else
 353                   Ind := Ind - 1;
 354                end if;
 355             end loop;
 356
 357          --  Mapped backward case
 358
 359          else
 360             for J in reverse 1 .. Source'Length - PL1 loop
 361                Cur := Ind;
 362
 363                for K in Pattern'Range loop
 364                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 365                      goto Cont2;
 366                   else
 367                      Cur := Cur + 1;
 368                   end if;
 369                end loop;
 370
 371                return Ind;
 372
 373             <<Cont2>>
 374                Ind := Ind - 1;
 375             end loop;
 376          end if;
 377       end if;
 378
 379       --  Fall through if no match found. Note that the loops are skipped
 380       --  completely in the case of the pattern being longer than the source.
 381
 382       return 0;
 383    end Index;
 384
 385    function Index
 386      (Source  : String;
 387       Pattern : String;
 388       Going   : Direction := Forward;
 389       Mapping : Maps.Character_Mapping_Function) return Natural
 390    is
 391       PL1 : constant Integer := Pattern'Length - 1;
 392       Ind : Natural;
 393       Cur : Natural;
 394
 395    begin
 396       if Pattern = "" then
 397          raise Pattern_Error;
 398       end if;
 399
 400       --  Check for null pointer in case checks are off
 401
 402       if Mapping = null then
 403          raise Constraint_Error;
 404       end if;
 405
 406       --  If Pattern longer than Source it can't be found
 407
 408       if Pattern'Length > Source'Length then
 409          return 0;
 410       end if;
 411
 412       --  Forwards case
 413
 414       if Going = Forward then
 415          Ind := Source'First;
 416          for J in 1 .. Source'Length - PL1 loop
 417             Cur := Ind;
 418
 419             for K in Pattern'Range loop
 420                if Pattern (K) /= Mapping.all (Source (Cur)) then
 421                   goto Cont1;
 422                else
 423                   Cur := Cur + 1;
 424                end if;
 425             end loop;
 426
 427             return Ind;
 428
 429          <<Cont1>>
 430             Ind := Ind + 1;
 431          end loop;
 432
 433       --  Backwards case
 434
 435       else
 436          Ind := Source'Last - PL1;
 437          for J in reverse 1 .. Source'Length - PL1 loop
 438             Cur := Ind;
 439
 440             for K in Pattern'Range loop
 441                if Pattern (K) /= Mapping.all (Source (Cur)) then
 442                   goto Cont2;
 443                else
 444                   Cur := Cur + 1;
 445                end if;
 446             end loop;
 447
 448             return Ind;
 449
 450          <<Cont2>>
 451             Ind := Ind - 1;
 452          end loop;
 453       end if;
 454
 455       --  Fall through if no match found. Note that the loops are skipped
 456       --  completely in the case of the pattern being longer than the source.
 457
 458       return 0;
 459    end Index;
 460
 461    function Index
 462      (Source : String;
 463       Set    : Maps.Character_Set;
 464       Test   : Membership := Inside;
 465       Going  : Direction  := Forward) return Natural
 466    is
 467    begin
 468       --  Forwards case
 469
 470       if Going = Forward then
 471          for J in Source'Range loop
 472             if Belongs (Source (J), Set, Test) then
 473                return J;
 474             end if;
 475          end loop;
 476
 477       --  Backwards case
 478
 479       else
 480          for J in reverse Source'Range loop
 481             if Belongs (Source (J), Set, Test) then
 482                return J;
 483             end if;
 484          end loop;
 485       end if;
 486
 487       --  Fall through if no match
 488
 489       return 0;
 490    end Index;
 491
 492    function Index
 493      (Source  : String;
 494       Pattern : String;
 495       From    : Positive;
 496       Going   : Direction := Forward;
 497       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
 498    is
 499    begin
 500
 501       --  AI05-056: If source is empty result is always zero
 502
 503       if Source'Length = 0 then
 504          return 0;
 505
 506       elsif Going = Forward then
 507          if From < Source'First then
 508             raise Index_Error;
 509          end if;
 510
 511          return
 512            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 513
 514       else
 515          if From > Source'Last then
 516             raise Index_Error;
 517          end if;
 518
 519          return
 520            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 521       end if;
 522    end Index;
 523
 524    function Index
 525      (Source  : String;
 526       Pattern : String;
 527       From    : Positive;
 528       Going   : Direction := Forward;
 529       Mapping : Maps.Character_Mapping_Function) return Natural
 530    is
 531    begin
 532
 533       --  AI05-056: If source is empty result is always zero
 534
 535       if Source'Length = 0 then
 536          return 0;
 537
 538       elsif Going = Forward then
 539          if From < Source'First then
 540             raise Index_Error;
 541          end if;
 542
 543          return Index
 544            (Source (From .. Source'Last), Pattern, Forward, Mapping);
 545
 546       else
 547          if From > Source'Last then
 548             raise Index_Error;
 549          end if;
 550
 551          return Index
 552            (Source (Source'First .. From), Pattern, Backward, Mapping);
 553       end if;
 554    end Index;
 555
 556    function Index
 557      (Source  : String;
 558       Set     : Maps.Character_Set;
 559       From    : Positive;
 560       Test    : Membership := Inside;
 561       Going   : Direction := Forward) return Natural
 562    is
 563    begin
 564
 565       --  AI05-056 : if source is empty result is always 0.
 566
 567       if Source'Length = 0 then
 568          return 0;
 569
 570       elsif Going = Forward then
 571          if From < Source'First then
 572             raise Index_Error;
 573          end if;
 574
 575          return
 576            Index (Source (From .. Source'Last), Set, Test, Forward);
 577
 578       else
 579          if From > Source'Last then
 580             raise Index_Error;
 581          end if;
 582
 583          return
 584            Index (Source (Source'First .. From), Set, Test, Backward);
 585       end if;
 586    end Index;
 587
 588    ---------------------
 589    -- Index_Non_Blank --
 590    ---------------------
 591
 592    function Index_Non_Blank
 593      (Source : String;
 594       Going  : Direction := Forward) return Natural
 595    is
 596    begin
 597       if Going = Forward then
 598          for J in Source'Range loop
 599             if Source (J) /= ' ' then
 600                return J;
 601             end if;
 602          end loop;
 603
 604       else -- Going = Backward
 605          for J in reverse Source'Range loop
 606             if Source (J) /= ' ' then
 607                return J;
 608             end if;
 609          end loop;
 610       end if;
 611
 612       --  Fall through if no match
 613
 614       return 0;
 615    end Index_Non_Blank;
 616
 617    function Index_Non_Blank
 618      (Source : String;
 619       From   : Positive;
 620       Going  : Direction := Forward) return Natural
 621    is
 622    begin
 623       if Going = Forward then
 624          if From < Source'First then
 625             raise Index_Error;
 626          end if;
 627
 628          return
 629            Index_Non_Blank (Source (From .. Source'Last), Forward);
 630
 631       else
 632          if From > Source'Last then
 633             raise Index_Error;
 634          end if;
 635
 636          return
 637            Index_Non_Blank (Source (Source'First .. From), Backward);
 638       end if;
 639    end Index_Non_Blank;
 640
 641 end Ada.Strings.Search;