-----------------------------------------------------------------------
--                 Odd - The Other Display Debugger                  --
--                                                                   --
--                         Copyright (C) 2000                        --
--                 Emmanuel Briot and Arnaud Charlet                 --
--                                                                   --
-- Odd is free  software;  you can redistribute it and/or modify  it --
-- under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or --
-- (at your option) any later version.                               --
--                                                                   --
-- This program 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 along with this library; --
-- if not,  write to the  Free Software Foundation, Inc.,  59 Temple --
-- Place - Suite 330, Boston, MA 02111-1307, USA.                    --
-----------------------------------------------------------------------

with Items;   use Items;
with Debugger.Gdb;     use Debugger.Gdb;
with Debugger.Gdb.Ada; use Debugger.Gdb.Ada;
pragma Warnings (Off);
with GNAT.Expect;      use GNAT.Expect;
pragma Warnings (On);
with Ada.Calendar;     use Ada.Calendar;
with Process_Proxies;  use Process_Proxies;
with GNAT.OS_Lib;      use GNAT.OS_Lib;
with Debugger;         use Debugger;
with Gtk.Main;         use Gtk.Main;
with Ada.Text_IO;      use Ada.Text_IO;
with Language.Debugger; use Language.Debugger;
with GVD.Types;        use GVD.Types;
with GVD.Preferences;  use GVD.Preferences;

procedure Test_Parse is

   Gdb_Record : aliased Gdb_Debugger;
   Gdb        : Debugger_Access := Gdb_Record'Unchecked_Access;
   Lang       : aliased Gdb_Ada_Language;

   -----------------------
   -- Print_Special_Var --
   -----------------------

   procedure Print_Special_Var (Var : String) is
      V : Generic_Type_Access;
      T     : Time;
      Durat : Duration;
      File : File_Type;
      Type_Str : String (1 .. 10000);
      Index    : Natural;
      Repeat_Num : Positive;
      Last       : Natural;

   begin
      Put_Line ("------------------------------");
      Put_Line ("PRINT SPECIAL" & Var);
      T := Clock;
      V := Parse_Type (Gdb, Var);
      Durat := Clock - T;
--      Put_Line ("Parsing type, time=" & Durat'Img);
      if V /= null then
         T := Clock;
         Open (File, In_File, "tcb.out");
         Get_Line (File, Type_Str, Last);
         Close (File);
         Index := 1;
         Parse_Value (Lang'Access, Type_Str (1 .. Last),
                      Index, V, Repeat_Num);
         Durat := Clock - T;
--         Put_Line ("Parsing value, time=" & Durat'Img);
         Print (V.all);
      end if;
      New_Line;
   end Print_Special_Var;

   ---------------
   -- Print_Var --
   ---------------

   procedure Print_Var (Var : String) is
      V : Generic_Type_Access;
      T     : Time;
      Durat : Duration;
      Found : Boolean;
   begin
      Put_Line ("------------------------------");
      Put_Line ("PRINT " & Var);
      T := Clock;
      V := Parse_Type (Gdb, Var);
      Durat := Clock - T;
--      Put_Line ("Parsing type, time=" & Durat'Img);
      if V /= null then
         T := Clock;
         Parse_Value (Gdb, Var, V, Value_Found => Found);
         Durat := Clock - T;
--         Put_Line ("Parsing value, time=" & Durat'Img);
         Print (V.all);
      end if;

      New_Line;
   end Print_Var;

   ---------------------
   -- Print_Var_Parse --
   ---------------------

   procedure Print_Var_Parse (Var : String) is
   begin
      --  Print_Var ("Parse::" & Var);
      Print_Var (Var);
   end Print_Var_Parse;

   -------------------
   -- Print_Var_Bar --
   -------------------

   procedure Print_Var_Bar (Var : String) is
   begin
      --  Print_Var ("Bar::" & Var);
      Print_Var (Var);
   end Print_Var_Bar;


   List : Argument_List (1 .. 0);
   B : Breakpoint_Identifier;
begin
   Init;
   GVD_Prefs := new GVD_Preferences_Manager;
   Register_Default_Preferences (GVD_Prefs, Page_Prefix => "General:");
   Load_Preferences (GVD_Prefs, "./preferences");

   Set_Language (Gdb, Lang'Unchecked_Access);
   Set_Debugger (Lang'Access, Gdb);

   Spawn (Gdb, "", List, "", new Process_Proxy, null);

   --  Add_Filter
   --    (Get_Descriptor (Get_Process (Gdb)).all, Trace_Filter'Access);
   --  Add_Filter
   --    (Get_Descriptor (Get_Process (Gdb)).all, Trace_Filter'Access, Input);

   Initialize (Gdb);
   Set_Executable (Gdb, "parse");
   B := Break_Exception (Gdb, Unhandled => False);

   Run (Gdb);

   Stack_Up (Gdb);
   Print_Var_Parse ("Non_Existant_Variable");
   --  Check there is no error in that case.

   Print_Var_Parse ("A");
   Print_Var_Parse ("B");
   Print_Var_Parse ("C");
   Print_Var_Parse ("Sh");
   Print_Var_Parse ("Ssh");
   Print_Var_Parse ("S");
   Print_Var_Parse ("S2");
   Print_Var_Parse ("S3");
   Print_Var_Parse ("S4");
   Print_Var_Parse ("Dur");
   Print_Var_Parse ("R");
   Print_Var_Parse ("M");
   Print_Var_Parse ("Act");
   Print_Var_Parse ("My_Enum_Variable");
   Print_Var_Parse ("T");
   Print_Var_Parse ("Ea");
   Print_Var_Parse ("Ea2");
   Print_Var_Parse ("Aoa");
   Print_Var_Parse ("Fiia");
   Print_Var_Parse ("Iaa");
   Print_Var_Parse ("U");
   Print_Var_Parse ("Enum_Array_Variable");
   Print_Var_Parse ("Negative_Array_Variable");
   Print_Var_Parse ("Aa");
   Print_Var_Parse ("A3d");
   Print_Var_Parse ("Aos");
   Print_Var_Parse ("Nr");
   Print_Var_Parse ("V");
   Print_Var_Parse ("Mra");
   Print_Var_Parse ("W");
   Print_Var_Parse ("Rr");
   Print_Var_Parse ("Roa");
   Print_Var_Parse ("X");
   Print_Var_Parse ("Ar");
   Print_Var_Parse ("Z");
   Print_Var_Parse ("Y");
   Print_Var_Parse ("Y2");
   Print_Var_Parse ("Tt");
   Print_Var_Parse ("Ctt");
   Print_Var_Parse ("Ctt2");
   Print_Var_Parse ("T_Ptr.all");
   Print_Var_Parse ("T_Ptr2.all");
   Print_Var_Parse ("Ba");
   Print_Var_Parse ("Ba2");
   Print_Var_Parse ("RegExp");

   Print_Var_Parse ("Null_Ptr.all");
   Print_Var_Parse ("Ra");
   Print_Var_Parse ("Nvp");
   Print_Var_Parse ("My_Str");

   --  Print_Var_Parse ("Ut");
   --  Bug in gdb: it displays union with C fields 'integer a', instead of
   --  Ada fields 'a : integer'.

   --  Print_Var ("Parse::Tcb");
   --  Print_Special_Var ("Parse::Tcb");

   Stack_Down (Gdb);

   Print_Var_Bar ("A");
   Print_Var_Bar ("T");
   Print_Var_Bar ("R");
   Print_Var_Parse ("X1");

--   Stack_Up (Gdb);
   Print_Var ("Ustring");
   Print_Var ("Asu_Test");
   Print_Var ("Asu_Test2");
   Print_Var ("My_Exception");
   Close (Gdb);

exception
   when others =>
      Close (Gdb);
      raise;

end Test_Parse;
