------------------------------------------------------------------------------
-- --
--- GNAT RUNTIME COMPONENTS --
+-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . S T R I N G S . S E A R C H --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- case of identity mappings for Count and Index, and also Index_Non_Blank
-- is specialized (rather than using the general Index routine).
-
with Ada.Strings.Maps; use Ada.Strings.Maps;
+with System; use System;
package body Ada.Strings.Search is
Pattern : String;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
is
- N : Natural;
- J : Natural;
-
- Mapped_Source : String (Source'Range);
+ PL1 : constant Integer := Pattern'Length - 1;
+ Num : Natural;
+ Ind : Natural;
+ Cur : Natural;
begin
- for J in Source'Range loop
- Mapped_Source (J) := Value (Mapping, Source (J));
- end loop;
-
if Pattern = "" then
raise Pattern_Error;
end if;
- N := 0;
- J := Source'First;
+ Num := 0;
+ Ind := Source'First;
- while J <= Source'Last - (Pattern'Length - 1) loop
- if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
- N := N + 1;
- J := J + Pattern'Length;
- else
- J := J + 1;
- end if;
- end loop;
+ -- Unmapped case
- return N;
+ if Mapping'Address = Maps.Identity'Address then
+ while Ind <= Source'Last - PL1 loop
+ if Pattern = Source (Ind .. Ind + PL1) then
+ Num := Num + 1;
+ Ind := Ind + Pattern'Length;
+ else
+ Ind := Ind + 1;
+ end if;
+ end loop;
+
+ -- Mapped case
+
+ else
+ while Ind <= Source'Last - PL1 loop
+ Cur := Ind;
+ for K in Pattern'Range loop
+ if Pattern (K) /= Value (Mapping, Source (Cur)) then
+ Ind := Ind + 1;
+ goto Cont;
+ else
+ Cur := Cur + 1;
+ end if;
+ end loop;
+
+ Num := Num + 1;
+ Ind := Ind + Pattern'Length;
+
+ <<Cont>>
+ null;
+ end loop;
+ end if;
+
+ -- Return result
+
+ return Num;
end Count;
function Count
Pattern : String;
Mapping : Maps.Character_Mapping_Function) return Natural
is
- Mapped_Source : String (Source'Range);
- N : Natural;
- J : Natural;
+ PL1 : constant Integer := Pattern'Length - 1;
+ Num : Natural;
+ Ind : Natural;
+ Cur : Natural;
begin
if Pattern = "" then
raise Pattern_Error;
end if;
- -- We make sure Access_Check is unsuppressed so that the Mapping.all
- -- call will generate a friendly Constraint_Error if the value for
- -- Mapping is uninitialized (and hence null).
+ -- Check for null pointer in case checks are off
- declare
- pragma Unsuppress (Access_Check);
+ if Mapping = null then
+ raise Constraint_Error;
+ end if;
- begin
- for J in Source'Range loop
- Mapped_Source (J) := Mapping.all (Source (J));
+ Num := 0;
+ Ind := Source'First;
+ while Ind <= Source'Last - PL1 loop
+ Cur := Ind;
+ for K in Pattern'Range loop
+ if Pattern (K) /= Mapping (Source (Cur)) then
+ Ind := Ind + 1;
+ goto Cont;
+ else
+ Cur := Cur + 1;
+ end if;
end loop;
- end;
- N := 0;
- J := Source'First;
+ Num := Num + 1;
+ Ind := Ind + Pattern'Length;
- while J <= Source'Last - (Pattern'Length - 1) loop
- if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
- N := N + 1;
- J := J + Pattern'Length;
- else
- J := J + 1;
- end if;
+ <<Cont>>
+ null;
end loop;
- return N;
+ return Num;
end Count;
function Count
end if;
end loop;
- -- Here if J indexes 1st char of token, and all chars
- -- after J are in the token
+ -- Here if J indexes first char of token, and all chars after J
+ -- are in the token.
Last := Source'Last;
return;
Going : Direction := Forward;
Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
is
- Cur_Index : Natural;
- Mapped_Source : String (Source'Range);
+ PL1 : constant Integer := Pattern'Length - 1;
+ Cur : Natural;
+ Ind : Integer;
+ -- Index for start of match check. This can be negative if the pattern
+ -- length is greater than the string length, which is why this variable
+ -- is Integer instead of Natural. In this case, the search loops do not
+ -- execute at all, so this Ind value is never used.
begin
if Pattern = "" then
raise Pattern_Error;
end if;
- for J in Source'Range loop
- Mapped_Source (J) := Value (Mapping, Source (J));
- end loop;
-
-- Forwards case
if Going = Forward then
- for J in 1 .. Source'Length - Pattern'Length + 1 loop
- Cur_Index := Source'First + J - 1;
+ Ind := Source'First;
- if Pattern = Mapped_Source
- (Cur_Index .. Cur_Index + Pattern'Length - 1)
- then
- return Cur_Index;
- end if;
- end loop;
+ -- Unmapped forward case
+
+ if Mapping'Address = Maps.Identity'Address then
+ for J in 1 .. Source'Length - PL1 loop
+ if Pattern = Source (Ind .. Ind + PL1) then
+ return Ind;
+ else
+ Ind := Ind + 1;
+ end if;
+ end loop;
+
+ -- Mapped forward case
+
+ else
+ for J in 1 .. Source'Length - PL1 loop
+ Cur := Ind;
+
+ for K in Pattern'Range loop
+ if Pattern (K) /= Value (Mapping, Source (Cur)) then
+ goto Cont1;
+ else
+ Cur := Cur + 1;
+ end if;
+ end loop;
+
+ return Ind;
+
+ <<Cont1>>
+ Ind := Ind + 1;
+ end loop;
+ end if;
-- Backwards case
else
- for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
- Cur_Index := Source'First + J - 1;
+ -- Unmapped backward case
- if Pattern = Mapped_Source
- (Cur_Index .. Cur_Index + Pattern'Length - 1)
- then
- return Cur_Index;
- end if;
- end loop;
+ Ind := Source'Last - PL1;
+
+ if Mapping'Address = Maps.Identity'Address then
+ for J in reverse 1 .. Source'Length - PL1 loop
+ if Pattern = Source (Ind .. Ind + PL1) then
+ return Ind;
+ else
+ Ind := Ind - 1;
+ end if;
+ end loop;
+
+ -- Mapped backward case
+
+ else
+ for J in reverse 1 .. Source'Length - PL1 loop
+ Cur := Ind;
+
+ for K in Pattern'Range loop
+ if Pattern (K) /= Value (Mapping, Source (Cur)) then
+ goto Cont2;
+ else
+ Cur := Cur + 1;
+ end if;
+ end loop;
+
+ return Ind;
+
+ <<Cont2>>
+ Ind := Ind - 1;
+ end loop;
+ end if;
end if;
-- Fall through if no match found. Note that the loops are skipped
Going : Direction := Forward;
Mapping : Maps.Character_Mapping_Function) return Natural
is
- Mapped_Source : String (Source'Range);
- Cur_Index : Natural;
+ PL1 : constant Integer := Pattern'Length - 1;
+ Ind : Natural;
+ Cur : Natural;
begin
if Pattern = "" then
raise Pattern_Error;
end if;
- -- We make sure Access_Check is unsuppressed so that the Mapping.all
- -- call will generate a friendly Constraint_Error if the value for
- -- Mapping is uninitialized (and hence null).
+ -- Check for null pointer in case checks are off
- declare
- pragma Unsuppress (Access_Check);
- begin
- for J in Source'Range loop
- Mapped_Source (J) := Mapping.all (Source (J));
- end loop;
- end;
+ if Mapping = null then
+ raise Constraint_Error;
+ end if;
+
+ -- If Pattern longer than Source it can't be found
+
+ if Pattern'Length > Source'Length then
+ return 0;
+ end if;
-- Forwards case
if Going = Forward then
- for J in 1 .. Source'Length - Pattern'Length + 1 loop
- Cur_Index := Source'First + J - 1;
+ Ind := Source'First;
+ for J in 1 .. Source'Length - PL1 loop
+ Cur := Ind;
+
+ for K in Pattern'Range loop
+ if Pattern (K) /= Mapping.all (Source (Cur)) then
+ goto Cont1;
+ else
+ Cur := Cur + 1;
+ end if;
+ end loop;
- if Pattern = Mapped_Source
- (Cur_Index .. Cur_Index + Pattern'Length - 1)
- then
- return Cur_Index;
- end if;
+ return Ind;
+
+ <<Cont1>>
+ Ind := Ind + 1;
end loop;
-- Backwards case
else
- for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
- Cur_Index := Source'First + J - 1;
+ Ind := Source'Last - PL1;
+ for J in reverse 1 .. Source'Length - PL1 loop
+ Cur := Ind;
+
+ for K in Pattern'Range loop
+ if Pattern (K) /= Mapping.all (Source (Cur)) then
+ goto Cont2;
+ else
+ Cur := Cur + 1;
+ end if;
+ end loop;
- if Pattern = Mapped_Source
- (Cur_Index .. Cur_Index + Pattern'Length - 1)
- then
- return Cur_Index;
- end if;
+ return Ind;
+
+ <<Cont2>>
+ Ind := Ind - 1;
end loop;
end if;
+ -- Fall through if no match found. Note that the loops are skipped
+ -- completely in the case of the pattern being longer than the source.
+
return 0;
end Index;