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-2012, 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       First := Source'First;
 257       Last  := 0;
 258    end Find_Token;
 259
 260    -----------
 261    -- Index --
 262    -----------
 263
 264    function Index
 265      (Source  : Wide_Wide_String;
 266       Pattern : Wide_Wide_String;
 267       Going   : Direction := Forward;
 268       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 269         Wide_Wide_Maps.Identity) return Natural
 270    is
 271       PL1 : constant Integer := Pattern'Length - 1;
 272       Cur : Natural;
 273
 274       Ind : Integer;
 275       --  Index for start of match check. This can be negative if the pattern
 276       --  length is greater than the string length, which is why this variable
 277       --  is Integer instead of Natural. In this case, the search loops do not
 278       --  execute at all, so this Ind value is never used.
 279
 280    begin
 281       if Pattern = "" then
 282          raise Pattern_Error;
 283       end if;
 284
 285       --  Forwards case
 286
 287       if Going = Forward then
 288          Ind := Source'First;
 289
 290          --  Unmapped forward case
 291
 292          if Mapping'Address = Wide_Wide_Maps.Identity'Address then
 293             for J in 1 .. Source'Length - PL1 loop
 294                if Pattern = Source (Ind .. Ind + PL1) then
 295                   return Ind;
 296                else
 297                   Ind := Ind + 1;
 298                end if;
 299             end loop;
 300
 301          --  Mapped forward case
 302
 303          else
 304             for J in 1 .. Source'Length - PL1 loop
 305                Cur := Ind;
 306
 307                for K in Pattern'Range loop
 308                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 309                      goto Cont1;
 310                   else
 311                      Cur := Cur + 1;
 312                   end if;
 313                end loop;
 314
 315                return Ind;
 316
 317             <<Cont1>>
 318                Ind := Ind + 1;
 319             end loop;
 320          end if;
 321
 322       --  Backwards case
 323
 324       else
 325          --  Unmapped backward case
 326
 327          Ind := Source'Last - PL1;
 328
 329          if Mapping'Address = Wide_Wide_Maps.Identity'Address then
 330             for J in reverse 1 .. Source'Length - PL1 loop
 331                if Pattern = Source (Ind .. Ind + PL1) then
 332                   return Ind;
 333                else
 334                   Ind := Ind - 1;
 335                end if;
 336             end loop;
 337
 338          --  Mapped backward case
 339
 340          else
 341             for J in reverse 1 .. Source'Length - PL1 loop
 342                Cur := Ind;
 343
 344                for K in Pattern'Range loop
 345                   if Pattern (K) /= Value (Mapping, Source (Cur)) then
 346                      goto Cont2;
 347                   else
 348                      Cur := Cur + 1;
 349                   end if;
 350                end loop;
 351
 352                return Ind;
 353
 354             <<Cont2>>
 355                Ind := Ind - 1;
 356             end loop;
 357          end if;
 358       end if;
 359
 360       --  Fall through if no match found. Note that the loops are skipped
 361       --  completely in the case of the pattern being longer than the source.
 362
 363       return 0;
 364    end Index;
 365
 366    function Index
 367      (Source  : Wide_Wide_String;
 368       Pattern : Wide_Wide_String;
 369       Going   : Direction := Forward;
 370       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 371       return Natural
 372    is
 373       PL1 : constant Integer := Pattern'Length - 1;
 374       Ind : Natural;
 375       Cur : Natural;
 376
 377    begin
 378       if Pattern = "" then
 379          raise Pattern_Error;
 380       end if;
 381
 382       --  Check for null pointer in case checks are off
 383
 384       if Mapping = null then
 385          raise Constraint_Error;
 386       end if;
 387
 388       --  If Pattern longer than Source it can't be found
 389
 390       if Pattern'Length > Source'Length then
 391          return 0;
 392       end if;
 393
 394       --  Forwards case
 395
 396       if Going = Forward then
 397          Ind := Source'First;
 398          for J in 1 .. Source'Length - PL1 loop
 399             Cur := Ind;
 400
 401             for K in Pattern'Range loop
 402                if Pattern (K) /= Mapping.all (Source (Cur)) then
 403                   goto Cont1;
 404                else
 405                   Cur := Cur + 1;
 406                end if;
 407             end loop;
 408
 409             return Ind;
 410
 411          <<Cont1>>
 412             Ind := Ind + 1;
 413          end loop;
 414
 415       --  Backwards case
 416
 417       else
 418          Ind := Source'Last - PL1;
 419          for J in reverse 1 .. Source'Length - PL1 loop
 420             Cur := Ind;
 421
 422             for K in Pattern'Range loop
 423                if Pattern (K) /= Mapping.all (Source (Cur)) then
 424                   goto Cont2;
 425                else
 426                   Cur := Cur + 1;
 427                end if;
 428             end loop;
 429
 430             return Ind;
 431
 432          <<Cont2>>
 433             Ind := Ind - 1;
 434          end loop;
 435       end if;
 436
 437       --  Fall through if no match found. Note that the loops are skipped
 438       --  completely in the case of the pattern being longer than the source.
 439
 440       return 0;
 441    end Index;
 442
 443    function Index
 444      (Source : Wide_Wide_String;
 445       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
 446       Test   : Membership := Inside;
 447       Going  : Direction  := Forward) return Natural
 448    is
 449    begin
 450       --  Forwards case
 451
 452       if Going = Forward then
 453          for J in Source'Range loop
 454             if Belongs (Source (J), Set, Test) then
 455                return J;
 456             end if;
 457          end loop;
 458
 459       --  Backwards case
 460
 461       else
 462          for J in reverse Source'Range loop
 463             if Belongs (Source (J), Set, Test) then
 464                return J;
 465             end if;
 466          end loop;
 467       end if;
 468
 469       --  Fall through if no match
 470
 471       return 0;
 472    end Index;
 473
 474    function Index
 475      (Source  : Wide_Wide_String;
 476       Pattern : Wide_Wide_String;
 477       From    : Positive;
 478       Going   : Direction := Forward;
 479       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
 480         Wide_Wide_Maps.Identity) return Natural
 481    is
 482    begin
 483       if Going = Forward then
 484          if From < Source'First then
 485             raise Index_Error;
 486          end if;
 487
 488          return
 489            Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
 490
 491       else
 492          if From > Source'Last then
 493             raise Index_Error;
 494          end if;
 495
 496          return
 497            Index (Source (Source'First .. From), Pattern, Backward, Mapping);
 498       end if;
 499    end Index;
 500
 501    function Index
 502      (Source  : Wide_Wide_String;
 503       Pattern : Wide_Wide_String;
 504       From    : Positive;
 505       Going   : Direction := Forward;
 506       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
 507       return Natural
 508    is
 509    begin
 510       if Going = Forward then
 511          if From < Source'First then
 512             raise Index_Error;
 513          end if;
 514
 515          return Index
 516            (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 Index
 524            (Source (Source'First .. From), Pattern, Backward, Mapping);
 525       end if;
 526    end Index;
 527
 528    function Index
 529      (Source  : Wide_Wide_String;
 530       Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
 531       From    : Positive;
 532       Test    : Membership := Inside;
 533       Going   : Direction := Forward) return Natural
 534    is
 535    begin
 536       if Going = Forward then
 537          if From < Source'First then
 538             raise Index_Error;
 539          end if;
 540
 541          return
 542            Index (Source (From .. Source'Last), Set, Test, Forward);
 543
 544       else
 545          if From > Source'Last then
 546             raise Index_Error;
 547          end if;
 548
 549          return
 550            Index (Source (Source'First .. From), Set, Test, Backward);
 551       end if;
 552    end Index;
 553
 554    ---------------------
 555    -- Index_Non_Blank --
 556    ---------------------
 557
 558    function Index_Non_Blank
 559      (Source : Wide_Wide_String;
 560       Going  : Direction := Forward) return Natural
 561    is
 562    begin
 563       if Going = Forward then
 564          for J in Source'Range loop
 565             if Source (J) /= Wide_Wide_Space then
 566                return J;
 567             end if;
 568          end loop;
 569
 570       else -- Going = Backward
 571          for J in reverse Source'Range loop
 572             if Source (J) /= Wide_Wide_Space then
 573                return J;
 574             end if;
 575          end loop;
 576       end if;
 577
 578       --  Fall through if no match
 579
 580       return 0;
 581    end Index_Non_Blank;
 582
 583    function Index_Non_Blank
 584      (Source : Wide_Wide_String;
 585       From   : Positive;
 586       Going  : Direction := Forward) return Natural
 587    is
 588    begin
 589       if Going = Forward then
 590          if From < Source'First then
 591             raise Index_Error;
 592          end if;
 593
 594          return
 595            Index_Non_Blank (Source (From .. Source'Last), Forward);
 596
 597       else
 598          if From > Source'Last then
 599             raise Index_Error;
 600          end if;
 601
 602          return
 603            Index_Non_Blank (Source (Source'First .. From), Backward);
 604       end if;
 605    end Index_Non_Blank;
 606
 607 end Ada.Strings.Wide_Wide_Search;