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