-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT 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 the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with E_Strings.Not_SPARK;
with GNAT.Regexp;
with SparkMakeDebug;
with SystemErrors;

package body RegularExpression is

   ------------------------------------------------------
   -- Constructor
   ------------------------------------------------------

   function Create (E_Str : E_Strings.T) return Object
   --
   -- This function compiles the regular expression and then doesn't use it!
   -- This is to avoid having to with GNAT.Regexp in the specification and
   -- thus keeping the spec within the SPARK boundary.
   -- This function checks that a regular expression *can* be compiled for the
   -- given string. If it cannot then a null Object is returned that will
   -- cause a fatal error when passed to Matches.
   -- The Matches operation must then recompile the expression - but of course
   -- it knows it will succeed.
   -- This body is NOT within the SPARK boundary.
   is
      R      : GNAT.Regexp.Regexp;
      Valid  : Boolean := True;
      Result : Object;
      pragma Unreferenced (R);
   begin
      -- prohibit the {} characters
      for I in 1 .. E_Strings.Get_Length (E_Str => E_Str) loop
         if E_Strings.Get_Element (E_Str => E_Str,
                                   Pos   => I) = '{'
           or else E_Strings.Get_Element (E_Str => E_Str,
                                          Pos   => I) = '}' then
            Valid := False;
            exit;
         end if;
      end loop;
      if Valid then
         R      :=
           GNAT.Regexp.Compile
           (Pattern        => E_Strings.Not_SPARK.Get_String (E_Str => E_Str),
            Glob           => True,
            Case_Sensitive => False);
         Result := Object'(The_Reg_Exp => E_Str,
                           Is_Null_Exp => False);
      else
         SparkMakeDebug.Report_Text_E_Text (Text   => "Invalid regular expression",
                                            E_Text => E_Str);
         Result := Null_Object;
      end if;
      return Result;
   exception
      when GNAT.Regexp.Error_In_Regexp =>
         SparkMakeDebug.Report_Text_E_Text (Text   => "Invalid regular expression",
                                            E_Text => E_Str);
         return Null_Object;
   end Create;

   ------------------------------------------------------
   -- Accessors
   ------------------------------------------------------

   function Is_Null (O : Object) return Boolean is
   begin
      return O.Is_Null_Exp;
   end Is_Null;

   function Matches (E_Str       : E_Strings.T;
                     The_Reg_Exp : Object) return Boolean is
   begin
      if Is_Null (O => The_Reg_Exp) then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Other_Internal_Error,
                                   Msg     => "Illegal use of null regular expression");
         return False;
      else
         return GNAT.Regexp.Match
           (S => E_Strings.Not_SPARK.Get_String (E_Str => E_Str),
            R => GNAT.Regexp.Compile
              (Pattern        => E_Strings.Not_SPARK.Get_String (E_Str => The_Reg_Exp.The_Reg_Exp),
               Glob           => True,
               Case_Sensitive => False));
      end if;
   end Matches;

end RegularExpression;
