------------------------------------------------------------------------------
--                                  G P S                                   --
--                                                                          --
--                     Copyright (C) 2010-2015, AdaCore                     --
--                                                                          --
-- This library 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. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- 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/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with GNAT.IO;               use GNAT.IO;
with GNATCOLL.Traces;       use GNATCOLL.Traces;

package body Asserts is

   Module_Name : Unbounded_String;

   procedure Error (V1, V2 : String; Msg : String; Loc : String);
   --  Display an error message

   function Image (S : String_List) return String;
   function Image (S : File_Array) return String;
   --  Return a display version of S

   ----------------
   -- Set_Module --
   ----------------

   procedure Set_Module (Name : String) is
   begin
      Module_Name := To_Unbounded_String (Name);
   end Set_Module;

   -----------
   -- Error --
   -----------

   procedure Error (V1, V2 : String; Msg : String; Loc : String) is
   begin
      if Module_Name /= Null_Unbounded_String then
         Put_Line ("-------- Module: " & To_String (Module_Name));

         --  Only print the module name once
         Module_Name := Null_Unbounded_String;
      end if;

      Put_Line ("!! ERROR: " & Msg & " (at " & Loc & ")");
      Put_Line ("   expected: " & V2);
      Put_Line ("        got: " & V1);
      New_Line;
   end Error;

   -----------
   -- Image --
   -----------

   function Image (S : String_List) return String is
      Result : Unbounded_String;
   begin
      for C in S'Range loop
         if S (C) /= null then
            Append (Result, S (C).all);
         end if;

         Append (Result, ",");
      end loop;

      return To_String (Result);
   end Image;

   function Image (S : File_Array) return String is
      Result : Unbounded_String;
   begin
      for C in S'Range loop
         Append (Result, S (C).Display_Full_Name);
         Append (Result, ",");
      end loop;

      return To_String (Result);
   end Image;

   ------------
   -- Assert --
   ------------

   procedure Assert (S1, S2 : String; Msg : String := "";
                     Loc : String := GNAT.Source_Info.Source_Location)
   is
   begin
      if S1 /= S2 then
         Error (S1, S2, Msg, Loc);
      end if;
   end Assert;

   procedure Assert (S1 : Unbounded_String; S2 : String; Msg : String := "";
                     Loc : String := GNAT.Source_Info.Source_Location)
   is
   begin
      if S1 /= S2 then
         Error (To_String (S1), S2, Msg, Loc);
      end if;
   end Assert;

   procedure Assert (S1, S2 : Integer; Msg : String := "";
                     Loc : String := GNAT.Source_Info.Source_Location)
   is
   begin
      if S1 /= S2 then
         Error (Integer'Image (S1), Integer'Image (S2), Msg, Loc);
      end if;
   end Assert;

   procedure Assert (S1 : Boolean; Msg : String := "";
                     Loc : String := GNAT.Source_Info.Source_Location)
   is
   begin
      if not S1 then
         Error (Boolean'Image (S1), "True", Msg, Loc);
      end if;
   end Assert;

   procedure Assert (S1, S2 : String_List; Msg : String := "";
                     Loc : String := GNAT.Source_Info.Source_Location)
   is
      I1 : constant String := Image (S1);
      I2 : constant String := Image (S2);
   begin
      if I1 /= I2 then
         Error (I1, I2, Msg, Loc);
      end if;
   end Assert;

   procedure Assert (S1, S2 : File_Array; Msg : String := "";
                     Loc : String := GNAT.Source_Info.Source_Location)
   is
      I1 : constant String := Image (S1);
      I2 : constant String := Image (S2);
   begin
      if I1 /= I2 then
         Error (I1, I2, Msg, Loc);
      end if;
   end Assert;

begin
   GNATCOLL.Traces.Parse_Config_File (".gnatdebug");
end Asserts;
