gcc/ada/libgnat/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-2017, 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       --  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;