Index: src/natools-s_expressions-interpreters.adb ================================================================== --- src/natools-s_expressions-interpreters.adb +++ src/natools-s_expressions-interpreters.adb @@ -71,11 +71,11 @@ Self.Fallback_Name.Reset; end Reset_Fallback; not overriding procedure Execute - (Self : in out Interpreter; + (Self : in Interpreter; Expression : in out Lockable.Descriptor'Class; State : in out Shared_State; Context : in Shared_Context) is Event : Events.Event := Expression.Current_Event; @@ -106,23 +106,23 @@ end loop; end Execute; not overriding procedure Execute - (Self : in out Interpreter; - Fallback : in out Command'Class; + (Self : in Interpreter; + Fallback : in Command'Class; Expression : in out Lockable.Descriptor'Class; State : in out Shared_State; Context : in Shared_Context) is procedure Dispatch (Process : not null access procedure - (Name : in Atom; Cmd : in out Command'Class)); - procedure Process_Atom (Name : in Atom; Cmd : in out Command'Class); - procedure Process_Exp (Name : in Atom; Cmd : in out Command'Class); + (Name : in Atom; Cmd : in Command'Class)); + procedure Process_Atom (Name : in Atom; Cmd : in Command'Class); + procedure Process_Exp (Name : in Atom; Cmd : in Command'Class); procedure Dispatch (Process : not null access procedure - (Name : in Atom; Cmd : in out Command'Class)) + (Name : in Atom; Cmd : in Command'Class)) is procedure Process_Fallback (Name : in Atom); procedure Process_Fallback (Name : in Atom) is begin @@ -137,23 +137,23 @@ if Length > Self.Max_Length then Expression.Query_Atom (Process_Fallback'Access); else Cursor := Self.Commands.Find (Buffer (1 .. Length)); if Command_Maps.Has_Element (Cursor) then - Self.Commands.Update_Element (Cursor, Process); + Command_Maps.Query_Element (Cursor, Process); else Process (Buffer (1 .. Length), Fallback); end if; end if; end Dispatch; - procedure Process_Atom (Name : in Atom; Cmd : in out Command'Class) is + procedure Process_Atom (Name : in Atom; Cmd : in Command'Class) is begin Cmd.Execute (State, Context, Name); end Process_Atom; - procedure Process_Exp (Name : in Atom; Cmd : in out Command'Class) is + procedure Process_Exp (Name : in Atom; Cmd : in Command'Class) is pragma Unreferenced (Name); begin Cmd.Execute (State, Context, Expression); end Process_Exp; @@ -187,18 +187,18 @@ end loop; end Execute; overriding procedure Execute - (Self : in out Interpreter; + (Self : in Interpreter; State : in out Shared_State; Context : in Shared_Context; Name : in Atom) is - procedure Process_Atom (Key : in Atom; Cmd : in out Command'Class); + procedure Process_Atom (Key : in Atom; Cmd : in Command'Class); - procedure Process_Atom (Key : in Atom; Cmd : in out Command'Class) is + procedure Process_Atom (Key : in Atom; Cmd : in Command'Class) is pragma Unreferenced (Key); begin Cmd.Execute (State, Context, Name); end Process_Atom; @@ -205,19 +205,19 @@ Cursor : Command_Maps.Cursor; begin if Name'Length <= Self.Max_Length then Cursor := Self.Commands.Find (Name); if Command_Maps.Has_Element (Cursor) then - Self.Commands.Update_Element (Cursor, Process_Atom'Access); + Command_Maps.Query_Element (Cursor, Process_Atom'Access); return; end if; end if; if not Self.Fallback_Name.Is_Empty then Cursor := Self.Commands.Find (Self.Fallback_Name.Query.Data.all); if Command_Maps.Has_Element (Cursor) then - Self.Commands.Update_Element (Cursor, Process_Atom'Access); + Command_Maps.Query_Element (Cursor, Process_Atom'Access); return; end if; end if; raise Command_Not_Found @@ -224,18 +224,18 @@ with "Unknown command """ & To_String (Name) & '"'; end Execute; overriding procedure Execute - (Self : in out Interpreter; + (Self : in Interpreter; State : in out Shared_State; Context : in Shared_Context; Cmd : in out Lockable.Descriptor'Class) is - procedure Process_Exp (Name : in Atom; Actual : in out Command'Class); + procedure Process_Exp (Name : in Atom; Actual : in Command'Class); - procedure Process_Exp (Name : in Atom; Actual : in out Command'Class) is + procedure Process_Exp (Name : in Atom; Actual : in Command'Class) is pragma Unreferenced (Name); begin Actual.Execute (State, Context, Cmd); end Process_Exp; @@ -250,23 +250,23 @@ Cmd.Read_Atom (Buffer, Length); if Length <= Self.Max_Length then Cursor := Self.Commands.Find (Buffer (1 .. Length)); if Command_Maps.Has_Element (Cursor) then - Self.Commands.Update_Element (Cursor, Process_Exp'Access); + Command_Maps.Query_Element (Cursor, Process_Exp'Access); return; end if; end if; if not Self.Fallback_Name.Is_Empty then Cursor := Self.Commands.Find (Self.Fallback_Name.Query.Data.all); if Command_Maps.Has_Element (Cursor) then - Self.Commands.Update_Element (Cursor, Process_Exp'Access); + Command_Maps.Query_Element (Cursor, Process_Exp'Access); return; end if; end if; raise Command_Not_Found with "Unknown command """ & To_String (Cmd.Current_Atom) & '"'; end Execute; end Natools.S_Expressions.Interpreters; Index: src/natools-s_expressions-interpreters.ads ================================================================== --- src/natools-s_expressions-interpreters.ads +++ src/natools-s_expressions-interpreters.ads @@ -41,19 +41,19 @@ type Command is interface; procedure Execute - (Self : in out Command; + (Self : in Command; State : in out Shared_State; Context : in Shared_Context; Name : in Atom) is null; -- Execute a single argumentless command procedure Execute - (Self : in out Command; + (Self : in Command; State : in out Shared_State; Context : in Shared_Context; Cmd : in out Lockable.Descriptor'Class) is null; -- Execute a single command with arguments @@ -85,33 +85,33 @@ Name : in Atom); procedure Reset_Fallback (Self : in out Interpreter); not overriding procedure Execute - (Self : in out Interpreter; + (Self : in Interpreter; Expression : in out Lockable.Descriptor'Class; State : in out Shared_State; Context : in Shared_Context); -- Execute an expression, raising Command_Not_Found on unknown commands not overriding procedure Execute - (Self : in out Interpreter; - Fallback : in out Command'Class; + (Self : in Interpreter; + Fallback : in Command'Class; Expression : in out Lockable.Descriptor'Class; State : in out Shared_State; Context : in Shared_Context); -- Execute an expression with temporary fallback for unknown commands overriding procedure Execute - (Self : in out Interpreter; + (Self : in Interpreter; State : in out Shared_State; Context : in Shared_Context; Name : in Atom); -- Execute a single argumentless command overriding procedure Execute - (Self : in out Interpreter; + (Self : in Interpreter; State : in out Shared_State; Context : in Shared_Context; Cmd : in out Lockable.Descriptor'Class); -- Execute a single command with arguments Index: tests/natools-s_expressions-interpreter_tests.adb ================================================================== --- tests/natools-s_expressions-interpreter_tests.adb +++ tests/natools-s_expressions-interpreter_tests.adb @@ -62,11 +62,11 @@ ---------------------- -- Recorder Command -- ---------------------- overriding procedure Execute - (Self : in out Recorder; + (Self : in Recorder; State : in out Printers.Printer'Class; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Self); @@ -76,11 +76,11 @@ end if; end Execute; overriding procedure Execute - (Self : in out Recorder; + (Self : in Recorder; State : in out Printers.Printer'Class; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is pragma Unreferenced (Self); @@ -105,11 +105,11 @@ -------------------- -- Raiser Command -- -------------------- overriding procedure Execute - (Self : in out Raiser; + (Self : in Raiser; State : in out Printers.Printer'Class; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Self, State, Context, Name); @@ -117,11 +117,11 @@ raise Special_Exception; end Execute; overriding procedure Execute - (Self : in out Raiser; + (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); @@ -153,11 +153,11 @@ procedure Test_Basic_Usage (Report : in out NT.Reporter'Class) is Test : NT.Test := Report.Item ("Basic usage"); begin declare - Inter : Test_Interpreters.Interpreter := Test_Interpreter; + 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 @@ -194,11 +194,11 @@ procedure Test_Exception_Fallback (Report : in out NT.Reporter'Class) is Test : NT.Test := Report.Item ("Local fallback raising an exception"); begin declare - Inter : Test_Interpreters.Interpreter := Test_Interpreter; + 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; @@ -276,11 +276,11 @@ procedure Test_Local_Fallback (Report : in out NT.Reporter'Class) is Test : NT.Test := Report.Item ("Local fallback"); begin declare - Inter : Test_Interpreters.Interpreter := Test_Interpreter; + 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; Index: tests/natools-s_expressions-interpreter_tests.ads ================================================================== --- tests/natools-s_expressions-interpreter_tests.ads +++ tests/natools-s_expressions-interpreter_tests.ads @@ -45,33 +45,33 @@ (Printers.Printer'Class, Boolean); type Recorder is new Test_Interpreters.Command with null record; overriding procedure Execute - (Self : in out Recorder; + (Self : in Recorder; State : in out Printers.Printer'Class; Context : in Boolean; Name : in Atom); overriding procedure Execute - (Self : in out Recorder; + (Self : in Recorder; State : in out Printers.Printer'Class; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); Special_Exception : exception; type Raiser is new Test_Interpreters.Command with null record; overriding procedure Execute - (Self : in out Raiser; + (Self : in Raiser; State : in out Printers.Printer'Class; Context : in Boolean; Name : in Atom); overriding procedure Execute - (Self : in out Raiser; + (Self : in Raiser; State : in out Printers.Printer'Class; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); end Natools.S_Expressions.Interpreter_Tests;