Natools

natools-s_expressions-interpreter_tests.adb at [6eaac2a01c]
Login

File tests/natools-s_expressions-interpreter_tests.adb artifact 19cee4a167 part of check-in 6eaac2a01c


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Interpreter_Tests is

   function Test_Interpreter return Test_Interpreters.Interpreter;

   function Invalid_Commands return Caches.Reference;


   ------------------------
   -- Helper Subprograms --
   ------------------------

   function Invalid_Commands return Caches.Reference is
      Cache : Caches.Reference;
      Short : constant Atom := To_Atom ("not-cmd");
      Long : constant Atom := To_Atom ("not-a-command");
   begin
      Cache.Append_Atom (Short);
      Cache.Open_List;
      Cache.Append_Atom (Short);
      Cache.Append_Atom (To_Atom ("arg"));
      Cache.Close_List;
      Cache.Append_Atom (Long);
      Cache.Open_List;
      Cache.Append_Atom (Long);
      Cache.Open_List;
      Cache.Close_List;
      Cache.Close_List;
      return Cache;
   end Invalid_Commands;


   function Test_Interpreter return Test_Interpreters.Interpreter is
      Template : Recorder;
   begin
      return Inter : Test_Interpreters.Interpreter do
         Inter.Add ("cmd", Template);
         Inter.Add ("command", Template);
      end return;
   end Test_Interpreter;



   ----------------------
   -- Recorder Command --
   ----------------------

   overriding procedure Execute
     (Self : in Recorder;
      State : in out Printers.Printer'Class;
      Context : in Boolean;
      Name : in Atom)
   is
      pragma Unreferenced (Self);
   begin
      if Context then
         State.Append_Atom (Name);
      end if;
   end Execute;


   overriding procedure Execute
     (Self : in Recorder;
      State : in out Printers.Printer'Class;
      Context : in Boolean;
      Cmd : in out Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Self);
   begin
      if not Context then
         return;
      end if;

      declare
         Buffer : aliased Test_Tools.Memory_Stream;
         Serializer : Printers.Canonical (Buffer'Access);
      begin
         Printers.Transfer (Cmd, Serializer);
         State.Open_List;
         State.Append_Atom (Buffer.Get_Data);
         State.Close_List;
      end;
   end Execute;



   --------------------
   -- Raiser Command --
   --------------------

   overriding procedure Execute
     (Self : in Raiser;
      State : in out Printers.Printer'Class;
      Context : in Boolean;
      Name : in Atom)
   is
      pragma Unreferenced (Self, State, Context, Name);
   begin
      raise Special_Exception;
   end Execute;


   overriding procedure Execute
     (Self : in Raiser;
      State : in out Printers.Printer'Class;
      Context : in Boolean;
      Cmd : in out Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Self, State, Context, Cmd);
   begin
      raise Special_Exception;
   end Execute;



   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Test_Basic_Usage (Report);
      Test_Unknown_Commands (Report);
      Test_Premanent_Fallback (Report);
      Test_Local_Fallback (Report);
      Test_Exception_Fallback (Report);
      Test_Inspection (Report);
   end All_Tests;



   ----------------------
   -- Individual Tests --
   ----------------------

   procedure Test_Basic_Usage (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Basic usage");
   begin
      declare
         Inter : constant Test_Interpreters.Interpreter := Test_Interpreter;
         Buffer : aliased Test_Tools.Memory_Stream;
         Printer : Printers.Canonical (Buffer'Access);
         Input : Caches.Reference;
         Cursor : Caches.Cursor;
      begin
         Input.Append_Atom (To_Atom ("cmd"));
         Input.Open_List;
         Input.Append_Atom (To_Atom ("cmd"));
         Input.Append_Atom (To_Atom ("foo"));
         Input.Append_Atom (To_Atom ("bar"));
         Input.Close_List;
         Input.Append_Atom (To_Atom ("command"));
         Input.Open_List;
         Input.Open_List;
         Input.Append_Atom (To_Atom ("comment"));
         Input.Close_List;
         Input.Close_List;
         Input.Open_List;
         Input.Append_Atom (To_Atom ("command"));
         Input.Open_List;
         Input.Close_List;
         Input.Close_List;

         Cursor := Input.First;

         Buffer.Set_Expected (To_Atom
           ("3:cmd(15:3:cmd3:foo3:bar)7:command(11:7:command())"));

         Inter.Execute (Cursor, Printer, True);
         Buffer.Check_Stream (Test);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Basic_Usage;


   procedure Test_Exception_Fallback (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Local fallback raising an exception");
   begin
      declare
         Inter : constant Test_Interpreters.Interpreter := Test_Interpreter;
         Buffer : aliased Test_Tools.Memory_Stream;
         Printer : Printers.Canonical (Buffer'Access);
         Input : Caches.Reference;
         Cursor : Caches.Cursor;
         Fallback : Raiser;
      begin
         Input.Append_Atom (To_Atom ("cmd"));
         Input.Open_List;
         Input.Append_Atom (To_Atom ("unknown"));
         Input.Append_Atom (To_Atom ("argument"));
         Input.Close_List;
         Input.Close_List;
         Input.Open_List;
         Input.Append_Atom (To_Atom ("command"));
         Input.Close_List;
         Cursor := Input.First;

         Buffer.Set_Expected (To_Atom ("3:cmd"));

         begin
            Inter.Execute (Fallback, Cursor, Printer, True);
            Test.Fail ("No exception raised");
         exception
            when Special_Exception => null;
            when Error : others =>
               Test.Fail ("Wrong exception raised:");
               Test.Report_Exception (Error, NT.Fail);
         end;

         Buffer.Check_Stream (Test);

         Test_Tools.Next_And_Check (Test, Cursor, To_Atom ("argument"), 1);
         Test_Tools.Next_And_Check (Test, Cursor, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Cursor, Events.Open_List, 1);
         Test_Tools.Next_And_Check (Test, Cursor, To_Atom ("command"), 1);
         Test_Tools.Next_And_Check (Test, Cursor, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Cursor, Events.End_Of_Input, 0);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Exception_Fallback;


   procedure Test_Inspection (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Inspection");
   begin
      declare
         Inter : Test_Interpreters.Interpreter;
      begin
         if not Inter.Is_Empty then
            Test.Fail ("Default interpreter is not empty");
         end if;

         if Inter.Has_Command (To_Atom ("cmd")) then
            Test.Fail ("Default interpreter has command ""cmd""");
         end if;

         Inter := Test_Interpreter;

         if Inter.Is_Empty then
            Test.Fail ("Test interpreter is empty");
         end if;

         if not Inter.Has_Command (To_Atom ("cmd")) then
            Test.Fail ("Test interpreter has not command ""cmd""");
         end if;

         if Inter.Has_Command (To_Atom ("not-a-cmd")) then
            Test.Fail ("Test interpreter has command ""not-a-cmd""");
         end if;

      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Inspection;


   procedure Test_Local_Fallback (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Local fallback");
   begin
      declare
         Inter : constant Test_Interpreters.Interpreter := Test_Interpreter;
         Buffer : aliased Test_Tools.Memory_Stream;
         Printer : Printers.Canonical (Buffer'Access);
         Input : Caches.Reference := Invalid_Commands;
         Cursor : Caches.Cursor := Input.First;
         Fallback : Recorder;
      begin
         Input.Append_Atom (To_Atom ("cmd"));
         Buffer.Set_Expected (To_Atom
           ("7:not-cmd(14:7:not-cmd3:arg)13:not-a-command"
            & "(18:13:not-a-command())3:cmd"));

         Inter.Execute (Fallback, Cursor, Printer, True);

         Buffer.Check_Stream (Test);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Local_Fallback;


   procedure Test_Premanent_Fallback (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Permanent fallback");
   begin
      declare
         Inter : constant Test_Interpreters.Interpreter
           := Test_Interpreters.Build
             ((Test_Interpreters.Item ("cmd", Recorder'(null record)),
               Test_Interpreters.Item ("command", Recorder'(null record))),
               Fallback => "cmd");
         Buffer : aliased Test_Tools.Memory_Stream;
         Printer : Printers.Canonical (Buffer'Access);
         Input : constant Caches.Reference := Invalid_Commands;
         Cursor : Caches.Cursor := Input.First;
      begin
         Buffer.Set_Expected (To_Atom
           ("7:not-cmd(14:7:not-cmd3:arg)13:not-a-command"
            & "(18:13:not-a-command())"));

         Inter.Execute (Cursor, Printer, True);

         Buffer.Check_Stream (Test);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Premanent_Fallback;


   procedure Test_Unknown_Commands (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Unknown commands");
   begin
      declare
         Inter : Test_Interpreters.Interpreter := Test_Interpreter;
         Buffer : aliased Test_Tools.Memory_Stream;
         Printer : Printers.Canonical (Buffer'Access);
         Input : constant Caches.Reference := Invalid_Commands;
         Cursor : Caches.Cursor := Input.First;
      begin
         Inter.Set_Fallback (To_Atom ("cmd"));
         Inter.Reset_Fallback;

         begin
            Inter.Execute (Cursor, Printer, True);
            Test.Fail ("No exception raised after not-cmd");
         exception
            when Test_Interpreters.Command_Not_Found => null;
            when Error : others =>
               Test.Fail ("Unexpected exception raised after not-cmd");
               Test.Report_Exception (Error, NT.Fail);
         end;

         Test_Tools.Next_And_Check (Test, Cursor, Events.Open_List, 1);

         begin
            Inter.Execute (Cursor, Printer, True);
            Test.Fail ("No exception raised after (not-cmd)");
         exception
            when Test_Interpreters.Command_Not_Found => null;
            when Error : others =>
               Test.Fail ("Unexpected exception raised after (not-cmd)");
               Test.Report_Exception (Error, NT.Fail);
         end;

         Test_Tools.Next_And_Check (Test, Cursor, To_Atom ("arg"), 1);
         Test_Tools.Next_And_Check (Test, Cursor, Events.Close_List, 0);
         Test_Tools.Next_And_Check
           (Test, Cursor, To_Atom ("not-a-command"), 0);

         begin
            Inter.Execute (Cursor, Printer, True);
            Test.Fail ("No exception raised after not-a-command");
         exception
            when Test_Interpreters.Command_Not_Found => null;
            when Error : others =>
               Test.Fail ("Unexpected exception raised after not-a-command");
               Test.Report_Exception (Error, NT.Fail);
         end;

         Test_Tools.Next_And_Check (Test, Cursor, Events.Open_List, 1);

         begin
            Inter.Execute (Cursor, Printer, True);
            Test.Fail ("No exception raised after not-a-command");
         exception
            when Test_Interpreters.Command_Not_Found => null;
            when Error : others =>
               Test.Fail ("Unexpected exception raised after not-a-command");
               Test.Report_Exception (Error, NT.Fail);
         end;

         Test_Tools.Next_And_Check (Test, Cursor, Events.Open_List, 2);
         Test_Tools.Next_And_Check (Test, Cursor, Events.Close_List, 1);
         Test_Tools.Next_And_Check (Test, Cursor, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Cursor, Events.End_Of_Input, 0);

         Buffer.Check_Stream (Test);
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Test_Unknown_Commands;

end Natools.S_Expressions.Interpreter_Tests;